home *** CD-ROM | disk | FTP | other *** search
/ Skunkware 98 / Skunkware 98.iso / src / interp / perl5.005.tar.gz / perl5.005.tar / perl5.005 / op.c < prev    next >
C/C++ Source or Header  |  1998-07-22  |  119KB  |  5,109 lines
  1. /*    op.c
  2.  *
  3.  *    Copyright (c) 1991-1997, Larry Wall
  4.  *
  5.  *    You may distribute under the terms of either the GNU General Public
  6.  *    License or the Artistic License, as specified in the README file.
  7.  *
  8.  */
  9.  
  10. /*
  11.  * "You see: Mr. Drogo, he married poor Miss Primula Brandybuck.  She was
  12.  * our Mr. Bilbo's first cousin on the mother's side (her mother being the
  13.  * youngest of the Old Took's daughters); and Mr. Drogo was his second
  14.  * cousin.  So Mr. Frodo is his first *and* second cousin, once removed
  15.  * either way, as the saying is, if you follow me."  --the Gaffer
  16.  */
  17.  
  18. #include "EXTERN.h"
  19. #include "perl.h"
  20.  
  21. #ifdef PERL_OBJECT
  22. #define CHECKCALL this->*check
  23. #else
  24. #define CHECKCALL *check
  25. #endif
  26.  
  27. /*
  28.  * In the following definition, the ", Nullop" is just to make the compiler
  29.  * think the expression is of the right type: croak actually does a Siglongjmp.
  30.  */
  31. #define CHECKOP(type,o) \
  32.     ((PL_op_mask && PL_op_mask[type])                    \
  33.      ? ( op_free((OP*)o),                    \
  34.      croak("%s trapped by operation mask", op_desc[type]),    \
  35.      Nullop )                        \
  36.      : (CHECKCALL[type])((OP*)o))
  37.  
  38. static bool scalar_mod_type _((OP *o, I32 type));
  39. #ifndef PERL_OBJECT
  40. static I32 list_assignment _((OP *o));
  41. static void bad_type _((I32 n, char *t, char *name, OP *kid));
  42. static OP *modkids _((OP *o, I32 type));
  43. static OP *no_fh_allowed _((OP *o));
  44. static OP *scalarboolean _((OP *o));
  45. static OP *too_few_arguments _((OP *o, char* name));
  46. static OP *too_many_arguments _((OP *o, char* name));
  47. static void null _((OP* o));
  48. static PADOFFSET pad_findlex _((char* name, PADOFFSET newoff, U32 seq,
  49.     CV* startcv, I32 cx_ix));
  50. static OP *newDEFSVOP _((void));
  51. static OP *new_logop _((I32 type, I32 flags, OP **firstp, OP **otherp));
  52. #endif
  53.  
  54. STATIC char*
  55. gv_ename(GV *gv)
  56. {
  57.     SV* tmpsv = sv_newmortal();
  58.     gv_efullname3(tmpsv, gv, Nullch);
  59.     return SvPV(tmpsv,PL_na);
  60. }
  61.  
  62. STATIC OP *
  63. no_fh_allowed(OP *o)
  64. {
  65.     yyerror(form("Missing comma after first argument to %s function",
  66.          op_desc[o->op_type]));
  67.     return o;
  68. }
  69.  
  70. STATIC OP *
  71. too_few_arguments(OP *o, char *name)
  72. {
  73.     yyerror(form("Not enough arguments for %s", name));
  74.     return o;
  75. }
  76.  
  77. STATIC OP *
  78. too_many_arguments(OP *o, char *name)
  79. {
  80.     yyerror(form("Too many arguments for %s", name));
  81.     return o;
  82. }
  83.  
  84. STATIC void
  85. bad_type(I32 n, char *t, char *name, OP *kid)
  86. {
  87.     yyerror(form("Type of arg %d to %s must be %s (not %s)",
  88.          (int)n, name, t, op_desc[kid->op_type]));
  89. }
  90.  
  91. void
  92. assertref(OP *o)
  93. {
  94.     int type = o->op_type;
  95.     if (type != OP_AELEM && type != OP_HELEM) {
  96.     yyerror(form("Can't use subscript on %s", op_desc[type]));
  97.     if (type == OP_ENTERSUB || type == OP_RV2HV || type == OP_PADHV) {
  98.         dTHR;
  99.         SV *msg = sv_2mortal(
  100.             newSVpvf("(Did you mean $ or @ instead of %c?)\n",
  101.                  type == OP_ENTERSUB ? '&' : '%'));
  102.         if (PL_in_eval & 2)
  103.         warn("%_", msg);
  104.         else if (PL_in_eval)
  105.         sv_catsv(GvSV(PL_errgv), msg);
  106.         else
  107.         PerlIO_write(PerlIO_stderr(), SvPVX(msg), SvCUR(msg));
  108.     }
  109.     }
  110. }
  111.  
  112. /* "register" allocation */
  113.  
  114. PADOFFSET
  115. pad_allocmy(char *name)
  116. {
  117.     dTHR;
  118.     PADOFFSET off;
  119.     SV *sv;
  120.  
  121.     if (!(isALPHA(name[1]) || name[1] == '_' && (int)strlen(name) > 2)) {
  122.     if (!isPRINT(name[1])) {
  123.         name[3] = '\0';
  124.         name[2] = toCTRL(name[1]);
  125.         name[1] = '^';
  126.     }
  127.     croak("Can't use global %s in \"my\"",name);
  128.     }
  129.     if (PL_dowarn && AvFILLp(PL_comppad_name) >= 0) {
  130.     SV **svp = AvARRAY(PL_comppad_name);
  131.     for (off = AvFILLp(PL_comppad_name); off > PL_comppad_name_floor; off--) {
  132.         if ((sv = svp[off])
  133.         && sv != &PL_sv_undef
  134.         && SvIVX(sv) == 999999999       /* var is in open scope */
  135.         && strEQ(name, SvPVX(sv)))
  136.         {
  137.         warn("\"my\" variable %s masks earlier declaration in same scope", name);
  138.         break;
  139.         }
  140.     }
  141.     }
  142.     off = pad_alloc(OP_PADSV, SVs_PADMY);
  143.     sv = NEWSV(1102,0);
  144.     sv_upgrade(sv, SVt_PVNV);
  145.     sv_setpv(sv, name);
  146.     if (PL_in_my_stash) {
  147.     if (*name != '$')
  148.         croak("Can't declare class for non-scalar %s in \"my\"",name);
  149.     SvOBJECT_on(sv);
  150.     (void)SvUPGRADE(sv, SVt_PVMG);
  151.     SvSTASH(sv) = (HV*)SvREFCNT_inc(PL_in_my_stash);
  152.     PL_sv_objcount++;
  153.     }
  154.     av_store(PL_comppad_name, off, sv);
  155.     SvNVX(sv) = (double)999999999;
  156.     SvIVX(sv) = 0;            /* Not yet introduced--see newSTATEOP */
  157.     if (!PL_min_intro_pending)
  158.     PL_min_intro_pending = off;
  159.     PL_max_intro_pending = off;
  160.     if (*name == '@')
  161.     av_store(PL_comppad, off, (SV*)newAV());
  162.     else if (*name == '%')
  163.     av_store(PL_comppad, off, (SV*)newHV());
  164.     SvPADMY_on(PL_curpad[off]);
  165.     return off;
  166. }
  167.  
  168. STATIC PADOFFSET
  169. pad_findlex(char *name, PADOFFSET newoff, U32 seq, CV* startcv, I32 cx_ix)
  170. {
  171.     dTHR;
  172.     CV *cv;
  173.     I32 off;
  174.     SV *sv;
  175.     register I32 i;
  176.     register PERL_CONTEXT *cx;
  177.     int saweval;
  178.  
  179.     for (cv = startcv; cv; cv = CvOUTSIDE(cv)) {
  180.     AV *curlist = CvPADLIST(cv);
  181.     SV **svp = av_fetch(curlist, 0, FALSE);
  182.     AV *curname;
  183.  
  184.     if (!svp || *svp == &PL_sv_undef)
  185.         continue;
  186.     curname = (AV*)*svp;
  187.     svp = AvARRAY(curname);
  188.     for (off = AvFILLp(curname); off > 0; off--) {
  189.         if ((sv = svp[off]) &&
  190.         sv != &PL_sv_undef &&
  191.         seq <= SvIVX(sv) &&
  192.         seq > I_32(SvNVX(sv)) &&
  193.         strEQ(SvPVX(sv), name))
  194.         {
  195.         I32 depth;
  196.         AV *oldpad;
  197.         SV *oldsv;
  198.  
  199.         depth = CvDEPTH(cv);
  200.         if (!depth) {
  201.             if (newoff) {
  202.             if (SvFAKE(sv))
  203.                 continue;
  204.             return 0; /* don't clone from inactive stack frame */
  205.             }
  206.             depth = 1;
  207.         }
  208.         oldpad = (AV*)*av_fetch(curlist, depth, FALSE);
  209.         oldsv = *av_fetch(oldpad, off, TRUE);
  210.         if (!newoff) {        /* Not a mere clone operation. */
  211.             SV *namesv = NEWSV(1103,0);
  212.             newoff = pad_alloc(OP_PADSV, SVs_PADMY);
  213.             sv_upgrade(namesv, SVt_PVNV);
  214.             sv_setpv(namesv, name);
  215.             av_store(PL_comppad_name, newoff, namesv);
  216.             SvNVX(namesv) = (double)PL_curcop->cop_seq;
  217.             SvIVX(namesv) = 999999999;    /* A ref, intro immediately */
  218.             SvFAKE_on(namesv);        /* A ref, not a real var */
  219.             if (CvANON(PL_compcv) || SvTYPE(PL_compcv) == SVt_PVFM) {
  220.             /* "It's closures all the way down." */
  221.             CvCLONE_on(PL_compcv);
  222.             if (cv == startcv) {
  223.                 if (CvANON(PL_compcv))
  224.                 oldsv = Nullsv; /* no need to keep ref */
  225.             }
  226.             else {
  227.                 CV *bcv;
  228.                 for (bcv = startcv;
  229.                  bcv && bcv != cv && !CvCLONE(bcv);
  230.                  bcv = CvOUTSIDE(bcv)) {
  231.                 if (CvANON(bcv))
  232.                     CvCLONE_on(bcv);
  233.                 else {
  234.                     if (PL_dowarn && !CvUNIQUE(cv))
  235.                     warn(
  236.                       "Variable \"%s\" may be unavailable",
  237.                          name);
  238.                     break;
  239.                 }
  240.                 }
  241.             }
  242.             }
  243.             else if (!CvUNIQUE(PL_compcv)) {
  244.             if (PL_dowarn && !SvFAKE(sv) && !CvUNIQUE(cv))
  245.                 warn("Variable \"%s\" will not stay shared", name);
  246.             }
  247.         }
  248.         av_store(PL_comppad, newoff, SvREFCNT_inc(oldsv));
  249.         return newoff;
  250.         }
  251.     }
  252.     }
  253.  
  254.     /* Nothing in current lexical context--try eval's context, if any.
  255.      * This is necessary to let the perldb get at lexically scoped variables.
  256.      * XXX This will also probably interact badly with eval tree caching.
  257.      */
  258.  
  259.     saweval = 0;
  260.     for (i = cx_ix; i >= 0; i--) {
  261.     cx = &cxstack[i];
  262.     switch (cx->cx_type) {
  263.     default:
  264.         if (i == 0 && saweval) {
  265.         seq = cxstack[saweval].blk_oldcop->cop_seq;
  266.         return pad_findlex(name, newoff, seq, PL_main_cv, 0);
  267.         }
  268.         break;
  269.     case CXt_EVAL:
  270.         switch (cx->blk_eval.old_op_type) {
  271.         case OP_ENTEREVAL:
  272.         saweval = i;
  273.         break;
  274.         case OP_REQUIRE:
  275.         /* require must have its own scope */
  276.         return 0;
  277.         }
  278.         break;
  279.     case CXt_SUB:
  280.         if (!saweval)
  281.         return 0;
  282.         cv = cx->blk_sub.cv;
  283.         if (PL_debstash && CvSTASH(cv) == PL_debstash) {    /* ignore DB'* scope */
  284.         saweval = i;    /* so we know where we were called from */
  285.         continue;
  286.         }
  287.         seq = cxstack[saweval].blk_oldcop->cop_seq;
  288.         return pad_findlex(name, newoff, seq, cv, i-1);
  289.     }
  290.     }
  291.  
  292.     return 0;
  293. }
  294.  
  295. PADOFFSET
  296. pad_findmy(char *name)
  297. {
  298.     dTHR;
  299.     I32 off;
  300.     I32 pendoff = 0;
  301.     SV *sv;
  302.     SV **svp = AvARRAY(PL_comppad_name);
  303.     U32 seq = PL_cop_seqmax;
  304.  
  305. #ifdef USE_THREADS
  306.     /*
  307.      * Special case to get lexical (and hence per-thread) @_.
  308.      * XXX I need to find out how to tell at parse-time whether use
  309.      * of @_ should refer to a lexical (from a sub) or defgv (global
  310.      * scope and maybe weird sub-ish things like formats). See
  311.      * startsub in perly.y.  It's possible that @_ could be lexical
  312.      * (at least from subs) even in non-threaded perl.
  313.      */
  314.     if (strEQ(name, "@_"))
  315.     return 0;        /* success. (NOT_IN_PAD indicates failure) */
  316. #endif /* USE_THREADS */
  317.  
  318.     /* The one we're looking for is probably just before comppad_name_fill. */
  319.     for (off = AvFILLp(PL_comppad_name); off > 0; off--) {
  320.     if ((sv = svp[off]) &&
  321.         sv != &PL_sv_undef &&
  322.         (!SvIVX(sv) ||
  323.          (seq <= SvIVX(sv) &&
  324.           seq > I_32(SvNVX(sv)))) &&
  325.         strEQ(SvPVX(sv), name))
  326.     {
  327.         if (SvIVX(sv))
  328.         return (PADOFFSET)off;
  329.         pendoff = off;    /* this pending def. will override import */
  330.     }
  331.     }
  332.  
  333.     /* See if it's in a nested scope */
  334.     off = pad_findlex(name, 0, seq, CvOUTSIDE(PL_compcv), cxstack_ix);
  335.     if (off) {
  336.     /* If there is a pending local definition, this new alias must die */
  337.     if (pendoff)
  338.         SvIVX(AvARRAY(PL_comppad_name)[off]) = seq;
  339.     return off;        /* pad_findlex returns 0 for failure...*/
  340.     }
  341.     return NOT_IN_PAD;        /* ...but we return NOT_IN_PAD for failure */
  342. }
  343.  
  344. void
  345. pad_leavemy(I32 fill)
  346. {
  347.     I32 off;
  348.     SV **svp = AvARRAY(PL_comppad_name);
  349.     SV *sv;
  350.     if (PL_min_intro_pending && fill < PL_min_intro_pending) {
  351.     for (off = PL_max_intro_pending; off >= PL_min_intro_pending; off--) {
  352.         if ((sv = svp[off]) && sv != &PL_sv_undef)
  353.         warn("%s never introduced", SvPVX(sv));
  354.     }
  355.     }
  356.     /* "Deintroduce" my variables that are leaving with this scope. */
  357.     for (off = AvFILLp(PL_comppad_name); off > fill; off--) {
  358.     if ((sv = svp[off]) && sv != &PL_sv_undef && SvIVX(sv) == 999999999)
  359.         SvIVX(sv) = PL_cop_seqmax;
  360.     }
  361. }
  362.  
  363. PADOFFSET
  364. pad_alloc(I32 optype, U32 tmptype)
  365. {
  366.     dTHR;
  367.     SV *sv;
  368.     I32 retval;
  369.  
  370.     if (AvARRAY(PL_comppad) != PL_curpad)
  371.     croak("panic: pad_alloc");
  372.     if (PL_pad_reset_pending)
  373.     pad_reset();
  374.     if (tmptype & SVs_PADMY) {
  375.     do {
  376.         sv = *av_fetch(PL_comppad, AvFILLp(PL_comppad) + 1, TRUE);
  377.     } while (SvPADBUSY(sv));        /* need a fresh one */
  378.     retval = AvFILLp(PL_comppad);
  379.     }
  380.     else {
  381.     SV **names = AvARRAY(PL_comppad_name);
  382.     SSize_t names_fill = AvFILLp(PL_comppad_name);
  383.     for (;;) {
  384.         /*
  385.          * "foreach" index vars temporarily become aliases to non-"my"
  386.          * values.  Thus we must skip, not just pad values that are
  387.          * marked as current pad values, but also those with names.
  388.          */
  389.         if (++PL_padix <= names_fill &&
  390.            (sv = names[PL_padix]) && sv != &PL_sv_undef)
  391.         continue;
  392.         sv = *av_fetch(PL_comppad, PL_padix, TRUE);
  393.         if (!(SvFLAGS(sv) & (SVs_PADTMP|SVs_PADMY)))
  394.         break;
  395.     }
  396.     retval = PL_padix;
  397.     }
  398.     SvFLAGS(sv) |= tmptype;
  399.     PL_curpad = AvARRAY(PL_comppad);
  400. #ifdef USE_THREADS
  401.     DEBUG_X(PerlIO_printf(Perl_debug_log, "0x%lx Pad 0x%lx alloc %ld for %s\n",
  402.               (unsigned long) thr, (unsigned long) PL_curpad,
  403.               (long) retval, op_name[optype]));
  404. #else
  405.     DEBUG_X(PerlIO_printf(Perl_debug_log, "Pad 0x%lx alloc %ld for %s\n",
  406.               (unsigned long) PL_curpad,
  407.               (long) retval, op_name[optype]));
  408. #endif /* USE_THREADS */
  409.     return (PADOFFSET)retval;
  410. }
  411.  
  412. SV *
  413. pad_sv(PADOFFSET po)
  414. {
  415.     dTHR;
  416. #ifdef USE_THREADS
  417.     DEBUG_X(PerlIO_printf(Perl_debug_log, "0x%lx Pad 0x%lx sv %d\n",
  418.               (unsigned long) thr, (unsigned long) PL_curpad, po));
  419. #else
  420.     if (!po)
  421.     croak("panic: pad_sv po");
  422.     DEBUG_X(PerlIO_printf(Perl_debug_log, "Pad 0x%lx sv %d\n",
  423.               (unsigned long) PL_curpad, po));
  424. #endif /* USE_THREADS */
  425.     return PL_curpad[po];        /* eventually we'll turn this into a macro */
  426. }
  427.  
  428. void
  429. pad_free(PADOFFSET po)
  430. {
  431.     dTHR;
  432.     if (!PL_curpad)
  433.     return;
  434.     if (AvARRAY(PL_comppad) != PL_curpad)
  435.     croak("panic: pad_free curpad");
  436.     if (!po)
  437.     croak("panic: pad_free po");
  438. #ifdef USE_THREADS
  439.     DEBUG_X(PerlIO_printf(Perl_debug_log, "0x%lx Pad 0x%lx free %d\n",
  440.               (unsigned long) thr, (unsigned long) PL_curpad, po));
  441. #else
  442.     DEBUG_X(PerlIO_printf(Perl_debug_log, "Pad 0x%lx free %d\n",
  443.               (unsigned long) PL_curpad, po));
  444. #endif /* USE_THREADS */
  445.     if (PL_curpad[po] && PL_curpad[po] != &PL_sv_undef)
  446.     SvPADTMP_off(PL_curpad[po]);
  447.     if ((I32)po < PL_padix)
  448.     PL_padix = po - 1;
  449. }
  450.  
  451. void
  452. pad_swipe(PADOFFSET po)
  453. {
  454.     dTHR;
  455.     if (AvARRAY(PL_comppad) != PL_curpad)
  456.     croak("panic: pad_swipe curpad");
  457.     if (!po)
  458.     croak("panic: pad_swipe po");
  459. #ifdef USE_THREADS
  460.     DEBUG_X(PerlIO_printf(Perl_debug_log, "0x%lx Pad 0x%lx swipe %d\n",
  461.               (unsigned long) thr, (unsigned long) PL_curpad, po));
  462. #else
  463.     DEBUG_X(PerlIO_printf(Perl_debug_log, "Pad 0x%lx swipe %d\n",
  464.               (unsigned long) PL_curpad, po));
  465. #endif /* USE_THREADS */
  466.     SvPADTMP_off(PL_curpad[po]);
  467.     PL_curpad[po] = NEWSV(1107,0);
  468.     SvPADTMP_on(PL_curpad[po]);
  469.     if ((I32)po < PL_padix)
  470.     PL_padix = po - 1;
  471. }
  472.  
  473. /* XXX pad_reset() is currently disabled because it results in serious bugs.
  474.  * It causes pad temp TARGs to be shared between OPs. Since TARGs are pushed
  475.  * on the stack by OPs that use them, there are several ways to get an alias
  476.  * to  a shared TARG.  Such an alias will change randomly and unpredictably.
  477.  * We avoid doing this until we can think of a Better Way.
  478.  * GSAR 97-10-29 */
  479. void
  480. pad_reset(void)
  481. {
  482. #ifdef USE_BROKEN_PAD_RESET
  483.     dTHR;
  484.     register I32 po;
  485.  
  486.     if (AvARRAY(PL_comppad) != PL_curpad)
  487.     croak("panic: pad_reset curpad");
  488. #ifdef USE_THREADS
  489.     DEBUG_X(PerlIO_printf(Perl_debug_log, "0x%lx Pad 0x%lx reset\n",
  490.               (unsigned long) thr, (unsigned long) PL_curpad));
  491. #else
  492.     DEBUG_X(PerlIO_printf(Perl_debug_log, "Pad 0x%lx reset\n",
  493.               (unsigned long) PL_curpad));
  494. #endif /* USE_THREADS */
  495.     if (!PL_tainting) {    /* Can't mix tainted and non-tainted temporaries. */
  496.     for (po = AvMAX(PL_comppad); po > PL_padix_floor; po--) {
  497.         if (PL_curpad[po] && !SvIMMORTAL(PL_curpad[po]))
  498.         SvPADTMP_off(PL_curpad[po]);
  499.     }
  500.     PL_padix = PL_padix_floor;
  501.     }
  502. #endif
  503.     PL_pad_reset_pending = FALSE;
  504. }
  505.  
  506. #ifdef USE_THREADS
  507. /* find_threadsv is not reentrant */
  508. PADOFFSET
  509. find_threadsv(char *name)
  510. {
  511.     dTHR;
  512.     char *p;
  513.     PADOFFSET key;
  514.     SV **svp;
  515.     /* We currently only handle names of a single character */
  516.     p = strchr(PL_threadsv_names, *name);
  517.     if (!p)
  518.     return NOT_IN_PAD;
  519.     key = p - PL_threadsv_names;
  520.     svp = av_fetch(thr->threadsv, key, FALSE);
  521.     if (!svp) {
  522.     SV *sv = NEWSV(0, 0);
  523.     av_store(thr->threadsv, key, sv);
  524.     thr->threadsvp = AvARRAY(thr->threadsv);
  525.     /*
  526.      * Some magic variables used to be automagically initialised
  527.      * in gv_fetchpv. Those which are now per-thread magicals get
  528.      * initialised here instead.
  529.      */
  530.     switch (*name) {
  531.     case '_':
  532.         break;
  533.     case ';':
  534.         sv_setpv(sv, "\034");
  535.         sv_magic(sv, 0, 0, name, 1); 
  536.         break;
  537.     case '&':
  538.     case '`':
  539.     case '\'':
  540.         PL_sawampersand = TRUE;
  541.         SvREADONLY_on(sv);
  542.         /* FALL THROUGH */
  543.  
  544.     /* XXX %! tied to Errno.pm needs to be added here.
  545.      * See gv_fetchpv(). */
  546.     /* case '!': */
  547.  
  548.     default:
  549.         sv_magic(sv, 0, 0, name, 1); 
  550.     }
  551.     DEBUG_L(PerlIO_printf(PerlIO_stderr(),
  552.                   "find_threadsv: new SV %p for $%s%c\n",
  553.                   sv, (*name < 32) ? "^" : "",
  554.                   (*name < 32) ? toCTRL(*name) : *name));
  555.     }
  556.     return key;
  557. }
  558. #endif /* USE_THREADS */
  559.  
  560. /* Destructor */
  561.  
  562. void
  563. op_free(OP *o)
  564. {
  565.     register OP *kid, *nextkid;
  566.  
  567.     if (!o || o->op_seq == (U16)-1)
  568.     return;
  569.  
  570.     if (o->op_flags & OPf_KIDS) {
  571.     for (kid = cUNOPo->op_first; kid; kid = nextkid) {
  572.         nextkid = kid->op_sibling; /* Get before next freeing kid */
  573.         op_free(kid);
  574.     }
  575.     }
  576.  
  577.     switch (o->op_type) {
  578.     case OP_NULL:
  579.     o->op_targ = 0;    /* Was holding old type, if any. */
  580.     break;
  581.     case OP_ENTEREVAL:
  582.     o->op_targ = 0;    /* Was holding hints. */
  583.     break;
  584. #ifdef USE_THREADS
  585.     case OP_THREADSV:
  586.     o->op_targ = 0;    /* Was holding index into thr->threadsv AV. */
  587.     break;
  588. #endif /* USE_THREADS */
  589.     default:
  590.     if (!(o->op_flags & OPf_REF)
  591.         || (check[o->op_type] != FUNC_NAME_TO_PTR(ck_ftst)))
  592.         break;
  593.     /* FALL THROUGH */
  594.     case OP_GVSV:
  595.     case OP_GV:
  596.     case OP_AELEMFAST:
  597.     SvREFCNT_dec(cGVOPo->op_gv);
  598.     break;
  599.     case OP_NEXTSTATE:
  600.     case OP_DBSTATE:
  601.     Safefree(cCOPo->cop_label);
  602.     SvREFCNT_dec(cCOPo->cop_filegv);
  603.     break;
  604.     case OP_CONST:
  605.     SvREFCNT_dec(cSVOPo->op_sv);
  606.     break;
  607.     case OP_GOTO:
  608.     case OP_NEXT:
  609.     case OP_LAST:
  610.     case OP_REDO:
  611.     if (o->op_flags & (OPf_SPECIAL|OPf_STACKED|OPf_KIDS))
  612.         break;
  613.     /* FALL THROUGH */
  614.     case OP_TRANS:
  615.     Safefree(cPVOPo->op_pv);
  616.     break;
  617.     case OP_SUBST:
  618.     op_free(cPMOPo->op_pmreplroot);
  619.     /* FALL THROUGH */
  620.     case OP_PUSHRE:
  621.     case OP_MATCH:
  622.     case OP_QR:
  623.     ReREFCNT_dec(cPMOPo->op_pmregexp);
  624.     break;
  625.     }
  626.  
  627.     if (o->op_targ > 0)
  628.     pad_free(o->op_targ);
  629.  
  630.     Safefree(o);
  631. }
  632.  
  633. STATIC void
  634. null(OP *o)
  635. {
  636.     if (o->op_type != OP_NULL && o->op_type != OP_THREADSV && o->op_targ > 0)
  637.     pad_free(o->op_targ);
  638.     o->op_targ = o->op_type;
  639.     o->op_type = OP_NULL;
  640.     o->op_ppaddr = ppaddr[OP_NULL];
  641. }
  642.  
  643. /* Contextualizers */
  644.  
  645. #define LINKLIST(o) ((o)->op_next ? (o)->op_next : linklist((OP*)o))
  646.  
  647. OP *
  648. linklist(OP *o)
  649. {
  650.     register OP *kid;
  651.  
  652.     if (o->op_next)
  653.     return o->op_next;
  654.  
  655.     /* establish postfix order */
  656.     if (cUNOPo->op_first) {
  657.     o->op_next = LINKLIST(cUNOPo->op_first);
  658.     for (kid = cUNOPo->op_first; kid; kid = kid->op_sibling) {
  659.         if (kid->op_sibling)
  660.         kid->op_next = LINKLIST(kid->op_sibling);
  661.         else
  662.         kid->op_next = o;
  663.     }
  664.     }
  665.     else
  666.     o->op_next = o;
  667.  
  668.     return o->op_next;
  669. }
  670.  
  671. OP *
  672. scalarkids(OP *o)
  673. {
  674.     OP *kid;
  675.     if (o && o->op_flags & OPf_KIDS) {
  676.     for (kid = cLISTOPo->op_first; kid; kid = kid->op_sibling)
  677.         scalar(kid);
  678.     }
  679.     return o;
  680. }
  681.  
  682. STATIC OP *
  683. scalarboolean(OP *o)
  684. {
  685.     if (PL_dowarn &&
  686.     o->op_type == OP_SASSIGN && cBINOPo->op_first->op_type == OP_CONST) {
  687.     dTHR;
  688.     line_t oldline = PL_curcop->cop_line;
  689.  
  690.     if (PL_copline != NOLINE)
  691.         PL_curcop->cop_line = PL_copline;
  692.     warn("Found = in conditional, should be ==");
  693.     PL_curcop->cop_line = oldline;
  694.     }
  695.     return scalar(o);
  696. }
  697.  
  698. OP *
  699. scalar(OP *o)
  700. {
  701.     OP *kid;
  702.  
  703.     /* assumes no premature commitment */
  704.     if (!o || (o->op_flags & OPf_WANT) || PL_error_count
  705.      || o->op_type == OP_RETURN)
  706.     return o;
  707.  
  708.     o->op_flags = (o->op_flags & ~OPf_WANT) | OPf_WANT_SCALAR;
  709.  
  710.     switch (o->op_type) {
  711.     case OP_REPEAT:
  712.     if (o->op_private & OPpREPEAT_DOLIST)
  713.         null(((LISTOP*)cBINOPo->op_first)->op_first);
  714.     scalar(cBINOPo->op_first);
  715.     break;
  716.     case OP_OR:
  717.     case OP_AND:
  718.     case OP_COND_EXPR:
  719.     for (kid = cUNOPo->op_first->op_sibling; kid; kid = kid->op_sibling)
  720.         scalar(kid);
  721.     break;
  722.     case OP_SPLIT:
  723.     if ((kid = cLISTOPo->op_first) && kid->op_type == OP_PUSHRE) {
  724.         if (!kPMOP->op_pmreplroot)
  725.         deprecate("implicit split to @_");
  726.     }
  727.     /* FALL THROUGH */
  728.     case OP_MATCH:
  729.     case OP_QR:
  730.     case OP_SUBST:
  731.     case OP_NULL:
  732.     default:
  733.     if (o->op_flags & OPf_KIDS) {
  734.         for (kid = cUNOPo->op_first; kid; kid = kid->op_sibling)
  735.         scalar(kid);
  736.     }
  737.     break;
  738.     case OP_LEAVE:
  739.     case OP_LEAVETRY:
  740.     kid = cLISTOPo->op_first;
  741.     scalar(kid);
  742.     while (kid = kid->op_sibling) {
  743.         if (kid->op_sibling)
  744.         scalarvoid(kid);
  745.         else
  746.         scalar(kid);
  747.     }
  748.     WITH_THR(PL_curcop = &PL_compiling);
  749.     break;
  750.     case OP_SCOPE:
  751.     case OP_LINESEQ:
  752.     case OP_LIST:
  753.     for (kid = cLISTOPo->op_first; kid; kid = kid->op_sibling) {
  754.         if (kid->op_sibling)
  755.         scalarvoid(kid);
  756.         else
  757.         scalar(kid);
  758.     }
  759.     WITH_THR(PL_curcop = &PL_compiling);
  760.     break;
  761.     }
  762.     return o;
  763. }
  764.  
  765. OP *
  766. scalarvoid(OP *o)
  767. {
  768.     OP *kid;
  769.     char* useless = 0;
  770.     SV* sv;
  771.  
  772.     /* assumes no premature commitment */
  773.     if (!o || (o->op_flags & OPf_WANT) == OPf_WANT_LIST || PL_error_count
  774.      || o->op_type == OP_RETURN)
  775.     return o;
  776.  
  777.     o->op_flags = (o->op_flags & ~OPf_WANT) | OPf_WANT_VOID;
  778.  
  779.     switch (o->op_type) {
  780.     default:
  781.     if (!(opargs[o->op_type] & OA_FOLDCONST))
  782.         break;
  783.     /* FALL THROUGH */
  784.     case OP_REPEAT:
  785.     if (o->op_flags & OPf_STACKED)
  786.         break;
  787.     goto func_ops;
  788.     case OP_SUBSTR:
  789.     if (o->op_private == 4)
  790.         break;
  791.     /* FALL THROUGH */
  792.     case OP_GVSV:
  793.     case OP_WANTARRAY:
  794.     case OP_GV:
  795.     case OP_PADSV:
  796.     case OP_PADAV:
  797.     case OP_PADHV:
  798.     case OP_PADANY:
  799.     case OP_AV2ARYLEN:
  800.     case OP_REF:
  801.     case OP_REFGEN:
  802.     case OP_SREFGEN:
  803.     case OP_DEFINED:
  804.     case OP_HEX:
  805.     case OP_OCT:
  806.     case OP_LENGTH:
  807.     case OP_VEC:
  808.     case OP_INDEX:
  809.     case OP_RINDEX:
  810.     case OP_SPRINTF:
  811.     case OP_AELEM:
  812.     case OP_AELEMFAST:
  813.     case OP_ASLICE:
  814.     case OP_HELEM:
  815.     case OP_HSLICE:
  816.     case OP_UNPACK:
  817.     case OP_PACK:
  818.     case OP_JOIN:
  819.     case OP_LSLICE:
  820.     case OP_ANONLIST:
  821.     case OP_ANONHASH:
  822.     case OP_SORT:
  823.     case OP_REVERSE:
  824.     case OP_RANGE:
  825.     case OP_FLIP:
  826.     case OP_FLOP:
  827.     case OP_CALLER:
  828.     case OP_FILENO:
  829.     case OP_EOF:
  830.     case OP_TELL:
  831.     case OP_GETSOCKNAME:
  832.     case OP_GETPEERNAME:
  833.     case OP_READLINK:
  834.     case OP_TELLDIR:
  835.     case OP_GETPPID:
  836.     case OP_GETPGRP:
  837.     case OP_GETPRIORITY:
  838.     case OP_TIME:
  839.     case OP_TMS:
  840.     case OP_LOCALTIME:
  841.     case OP_GMTIME:
  842.     case OP_GHBYNAME:
  843.     case OP_GHBYADDR:
  844.     case OP_GHOSTENT:
  845.     case OP_GNBYNAME:
  846.     case OP_GNBYADDR:
  847.     case OP_GNETENT:
  848.     case OP_GPBYNAME:
  849.     case OP_GPBYNUMBER:
  850.     case OP_GPROTOENT:
  851.     case OP_GSBYNAME:
  852.     case OP_GSBYPORT:
  853.     case OP_GSERVENT:
  854.     case OP_GPWNAM:
  855.     case OP_GPWUID:
  856.     case OP_GGRNAM:
  857.     case OP_GGRGID:
  858.     case OP_GETLOGIN:
  859.       func_ops:
  860.     if (!(o->op_private & OPpLVAL_INTRO))
  861.         useless = op_desc[o->op_type];
  862.     break;
  863.  
  864.     case OP_RV2GV:
  865.     case OP_RV2SV:
  866.     case OP_RV2AV:
  867.     case OP_RV2HV:
  868.     if (!(o->op_private & OPpLVAL_INTRO) &&
  869.         (!o->op_sibling || o->op_sibling->op_type != OP_READLINE))
  870.         useless = "a variable";
  871.     break;
  872.  
  873.     case OP_NEXTSTATE:
  874.     case OP_DBSTATE:
  875.     WITH_THR(PL_curcop = ((COP*)o));        /* for warning below */
  876.     break;
  877.  
  878.     case OP_CONST:
  879.     sv = cSVOPo->op_sv;
  880.     if (PL_dowarn) {
  881.         useless = "a constant";
  882.         if (SvNIOK(sv) && (SvNV(sv) == 0.0 || SvNV(sv) == 1.0))
  883.         useless = 0;
  884.         else if (SvPOK(sv)) {
  885.         if (strnEQ(SvPVX(sv), "di", 2) ||
  886.             strnEQ(SvPVX(sv), "ds", 2) ||
  887.             strnEQ(SvPVX(sv), "ig", 2))
  888.             useless = 0;
  889.         }
  890.     }
  891.     null(o);        /* don't execute a constant */
  892.     SvREFCNT_dec(sv);    /* don't even remember it */
  893.     break;
  894.  
  895.     case OP_POSTINC:
  896.     o->op_type = OP_PREINC;        /* pre-increment is faster */
  897.     o->op_ppaddr = ppaddr[OP_PREINC];
  898.     break;
  899.  
  900.     case OP_POSTDEC:
  901.     o->op_type = OP_PREDEC;        /* pre-decrement is faster */
  902.     o->op_ppaddr = ppaddr[OP_PREDEC];
  903.     break;
  904.  
  905.     case OP_OR:
  906.     case OP_AND:
  907.     case OP_COND_EXPR:
  908.     for (kid = cUNOPo->op_first->op_sibling; kid; kid = kid->op_sibling)
  909.         scalarvoid(kid);
  910.     break;
  911.  
  912.     case OP_NULL:
  913.     if (o->op_targ == OP_NEXTSTATE || o->op_targ == OP_DBSTATE)
  914.         WITH_THR(PL_curcop = ((COP*)o));    /* for warning below */
  915.     if (o->op_flags & OPf_STACKED)
  916.         break;
  917.     /* FALL THROUGH */
  918.     case OP_ENTERTRY:
  919.     case OP_ENTER:
  920.     case OP_SCALAR:
  921.     if (!(o->op_flags & OPf_KIDS))
  922.         break;
  923.     /* FALL THROUGH */
  924.     case OP_SCOPE:
  925.     case OP_LEAVE:
  926.     case OP_LEAVETRY:
  927.     case OP_LEAVELOOP:
  928.     case OP_LINESEQ:
  929.     case OP_LIST:
  930.     for (kid = cLISTOPo->op_first; kid; kid = kid->op_sibling)
  931.         scalarvoid(kid);
  932.     break;
  933.     case OP_ENTEREVAL:
  934.     scalarkids(o);
  935.     break;
  936.     case OP_REQUIRE:
  937.     /* all requires must return a boolean value */
  938.     o->op_flags &= ~OPf_WANT;
  939.     return scalar(o);
  940.     case OP_SPLIT:
  941.     if ((kid = cLISTOPo->op_first) && kid->op_type == OP_PUSHRE) {
  942.         if (!kPMOP->op_pmreplroot)
  943.         deprecate("implicit split to @_");
  944.     }
  945.     break;
  946.     }
  947.     if (useless && PL_dowarn)
  948.     warn("Useless use of %s in void context", useless);
  949.     return o;
  950. }
  951.  
  952. OP *
  953. listkids(OP *o)
  954. {
  955.     OP *kid;
  956.     if (o && o->op_flags & OPf_KIDS) {
  957.     for (kid = cLISTOPo->op_first; kid; kid = kid->op_sibling)
  958.         list(kid);
  959.     }
  960.     return o;
  961. }
  962.  
  963. OP *
  964. list(OP *o)
  965. {
  966.     OP *kid;
  967.  
  968.     /* assumes no premature commitment */
  969.     if (!o || (o->op_flags & OPf_WANT) || PL_error_count
  970.      || o->op_type == OP_RETURN)
  971.     return o;
  972.  
  973.     o->op_flags = (o->op_flags & ~OPf_WANT) | OPf_WANT_LIST;
  974.  
  975.     switch (o->op_type) {
  976.     case OP_FLOP:
  977.     case OP_REPEAT:
  978.     list(cBINOPo->op_first);
  979.     break;
  980.     case OP_OR:
  981.     case OP_AND:
  982.     case OP_COND_EXPR:
  983.     for (kid = cUNOPo->op_first->op_sibling; kid; kid = kid->op_sibling)
  984.         list(kid);
  985.     break;
  986.     default:
  987.     case OP_MATCH:
  988.     case OP_QR:
  989.     case OP_SUBST:
  990.     case OP_NULL:
  991.     if (!(o->op_flags & OPf_KIDS))
  992.         break;
  993.     if (!o->op_next && cUNOPo->op_first->op_type == OP_FLOP) {
  994.         list(cBINOPo->op_first);
  995.         return gen_constant_list(o);
  996.     }
  997.     case OP_LIST:
  998.     listkids(o);
  999.     break;
  1000.     case OP_LEAVE:
  1001.     case OP_LEAVETRY:
  1002.     kid = cLISTOPo->op_first;
  1003.     list(kid);
  1004.     while (kid = kid->op_sibling) {
  1005.         if (kid->op_sibling)
  1006.         scalarvoid(kid);
  1007.         else
  1008.         list(kid);
  1009.     }
  1010.     WITH_THR(PL_curcop = &PL_compiling);
  1011.     break;
  1012.     case OP_SCOPE:
  1013.     case OP_LINESEQ:
  1014.     for (kid = cLISTOPo->op_first; kid; kid = kid->op_sibling) {
  1015.         if (kid->op_sibling)
  1016.         scalarvoid(kid);
  1017.         else
  1018.         list(kid);
  1019.     }
  1020.     WITH_THR(PL_curcop = &PL_compiling);
  1021.     break;
  1022.     case OP_REQUIRE:
  1023.     /* all requires must return a boolean value */
  1024.     o->op_flags &= ~OPf_WANT;
  1025.     return scalar(o);
  1026.     }
  1027.     return o;
  1028. }
  1029.  
  1030. OP *
  1031. scalarseq(OP *o)
  1032. {
  1033.     OP *kid;
  1034.  
  1035.     if (o) {
  1036.     if (o->op_type == OP_LINESEQ ||
  1037.          o->op_type == OP_SCOPE ||
  1038.          o->op_type == OP_LEAVE ||
  1039.          o->op_type == OP_LEAVETRY)
  1040.     {
  1041.         dTHR;
  1042.         for (kid = cLISTOPo->op_first; kid; kid = kid->op_sibling) {
  1043.         if (kid->op_sibling) {
  1044.             scalarvoid(kid);
  1045.         }
  1046.         }
  1047.         PL_curcop = &PL_compiling;
  1048.     }
  1049.     o->op_flags &= ~OPf_PARENS;
  1050.     if (PL_hints & HINT_BLOCK_SCOPE)
  1051.         o->op_flags |= OPf_PARENS;
  1052.     }
  1053.     else
  1054.     o = newOP(OP_STUB, 0);
  1055.     return o;
  1056. }
  1057.  
  1058. STATIC OP *
  1059. modkids(OP *o, I32 type)
  1060. {
  1061.     OP *kid;
  1062.     if (o && o->op_flags & OPf_KIDS) {
  1063.     for (kid = cLISTOPo->op_first; kid; kid = kid->op_sibling)
  1064.         mod(kid, type);
  1065.     }
  1066.     return o;
  1067. }
  1068.  
  1069. OP *
  1070. mod(OP *o, I32 type)
  1071. {
  1072.     dTHR;
  1073.     OP *kid;
  1074.     SV *sv;
  1075.  
  1076.     if (!o || PL_error_count)
  1077.     return o;
  1078.  
  1079.     switch (o->op_type) {
  1080.     case OP_UNDEF:
  1081.     PL_modcount++;
  1082.     return o;
  1083.     case OP_CONST:
  1084.     if (!(o->op_private & (OPpCONST_ARYBASE)))
  1085.         goto nomod;
  1086.     if (PL_eval_start && PL_eval_start->op_type == OP_CONST) {
  1087.         PL_compiling.cop_arybase = (I32)SvIV(((SVOP*)PL_eval_start)->op_sv);
  1088.         PL_eval_start = 0;
  1089.     }
  1090.     else if (!type) {
  1091.         SAVEI32(PL_compiling.cop_arybase);
  1092.         PL_compiling.cop_arybase = 0;
  1093.     }
  1094.     else if (type == OP_REFGEN)
  1095.         goto nomod;
  1096.     else
  1097.         croak("That use of $[ is unsupported");
  1098.     break;
  1099.     case OP_STUB:
  1100.     if (o->op_flags & OPf_PARENS)
  1101.         break;
  1102.     goto nomod;
  1103.     case OP_ENTERSUB:
  1104.     if ((type == OP_UNDEF || type == OP_REFGEN) &&
  1105.         !(o->op_flags & OPf_STACKED)) {
  1106.         o->op_type = OP_RV2CV;        /* entersub => rv2cv */
  1107.         o->op_ppaddr = ppaddr[OP_RV2CV];
  1108.         assert(cUNOPo->op_first->op_type == OP_NULL);
  1109.         null(((LISTOP*)cUNOPo->op_first)->op_first);/* disable pushmark */
  1110.         break;
  1111.     }
  1112.     /* FALL THROUGH */
  1113.     default:
  1114.       nomod:
  1115.     /* grep, foreach, subcalls, refgen */
  1116.     if (type == OP_GREPSTART || type == OP_ENTERSUB || type == OP_REFGEN)
  1117.         break;
  1118.     yyerror(form("Can't modify %s in %s",
  1119.              op_desc[o->op_type],
  1120.              type ? op_desc[type] : "local"));
  1121.     return o;
  1122.  
  1123.     case OP_PREINC:
  1124.     case OP_PREDEC:
  1125.     case OP_POW:
  1126.     case OP_MULTIPLY:
  1127.     case OP_DIVIDE:
  1128.     case OP_MODULO:
  1129.     case OP_REPEAT:
  1130.     case OP_ADD:
  1131.     case OP_SUBTRACT:
  1132.     case OP_CONCAT:
  1133.     case OP_LEFT_SHIFT:
  1134.     case OP_RIGHT_SHIFT:
  1135.     case OP_BIT_AND:
  1136.     case OP_BIT_XOR:
  1137.     case OP_BIT_OR:
  1138.     case OP_I_MULTIPLY:
  1139.     case OP_I_DIVIDE:
  1140.     case OP_I_MODULO:
  1141.     case OP_I_ADD:
  1142.     case OP_I_SUBTRACT:
  1143.     if (!(o->op_flags & OPf_STACKED))
  1144.         goto nomod;
  1145.     PL_modcount++;
  1146.     break;
  1147.     
  1148.     case OP_COND_EXPR:
  1149.     for (kid = cUNOPo->op_first->op_sibling; kid; kid = kid->op_sibling)
  1150.         mod(kid, type);
  1151.     break;
  1152.  
  1153.     case OP_RV2AV:
  1154.     case OP_RV2HV:
  1155.     if (!type && cUNOPo->op_first->op_type != OP_GV)
  1156.         croak("Can't localize through a reference");
  1157.     if (type == OP_REFGEN && o->op_flags & OPf_PARENS) {
  1158.         PL_modcount = 10000;
  1159.         return o;        /* Treat \(@foo) like ordinary list. */
  1160.     }
  1161.     /* FALL THROUGH */
  1162.     case OP_RV2GV:
  1163.     if (scalar_mod_type(o, type))
  1164.         goto nomod;
  1165.     ref(cUNOPo->op_first, o->op_type);
  1166.     /* FALL THROUGH */
  1167.     case OP_AASSIGN:
  1168.     case OP_ASLICE:
  1169.     case OP_HSLICE:
  1170.     case OP_NEXTSTATE:
  1171.     case OP_DBSTATE:
  1172.     case OP_REFGEN:
  1173.     case OP_CHOMP:
  1174.     PL_modcount = 10000;
  1175.     break;
  1176.     case OP_RV2SV:
  1177.     if (!type && cUNOPo->op_first->op_type != OP_GV)
  1178.         croak("Can't localize through a reference");
  1179.     ref(cUNOPo->op_first, o->op_type);
  1180.     /* FALL THROUGH */
  1181.     case OP_GV:
  1182.     case OP_AV2ARYLEN:
  1183.     PL_hints |= HINT_BLOCK_SCOPE;
  1184.     case OP_SASSIGN:
  1185.     case OP_AELEMFAST:
  1186.     PL_modcount++;
  1187.     break;
  1188.  
  1189.     case OP_PADAV:
  1190.     case OP_PADHV:
  1191.     PL_modcount = 10000;
  1192.     if (type == OP_REFGEN && o->op_flags & OPf_PARENS)
  1193.         return o;        /* Treat \(@foo) like ordinary list. */
  1194.     if (scalar_mod_type(o, type))
  1195.         goto nomod;
  1196.     /* FALL THROUGH */
  1197.     case OP_PADSV:
  1198.     PL_modcount++;
  1199.     if (!type)
  1200.         croak("Can't localize lexical variable %s",
  1201.         SvPV(*av_fetch(PL_comppad_name, o->op_targ, 4), PL_na));
  1202.     break;
  1203.  
  1204. #ifdef USE_THREADS
  1205.     case OP_THREADSV:
  1206.     PL_modcount++;    /* XXX ??? */
  1207.     break;
  1208. #endif /* USE_THREADS */
  1209.  
  1210.     case OP_PUSHMARK:
  1211.     break;
  1212.     
  1213.     case OP_KEYS:
  1214.     if (type != OP_SASSIGN)
  1215.         goto nomod;
  1216.     goto lvalue_func;
  1217.     case OP_SUBSTR:
  1218.     if (o->op_private == 4) /* don't allow 4 arg substr as lvalue */
  1219.         goto nomod;
  1220.     /* FALL THROUGH */
  1221.     case OP_POS:
  1222.     case OP_VEC:
  1223.       lvalue_func:
  1224.     pad_free(o->op_targ);
  1225.     o->op_targ = pad_alloc(o->op_type, SVs_PADMY);
  1226.     assert(SvTYPE(PAD_SV(o->op_targ)) == SVt_NULL);
  1227.     if (o->op_flags & OPf_KIDS)
  1228.         mod(cBINOPo->op_first->op_sibling, type);
  1229.     break;
  1230.  
  1231.     case OP_AELEM:
  1232.     case OP_HELEM:
  1233.     ref(cBINOPo->op_first, o->op_type);
  1234.     if (type == OP_ENTERSUB &&
  1235.          !(o->op_private & (OPpLVAL_INTRO | OPpDEREF)))
  1236.         o->op_private |= OPpLVAL_DEFER;
  1237.     PL_modcount++;
  1238.     break;
  1239.  
  1240.     case OP_SCOPE:
  1241.     case OP_LEAVE:
  1242.     case OP_ENTER:
  1243.     if (o->op_flags & OPf_KIDS)
  1244.         mod(cLISTOPo->op_last, type);
  1245.     break;
  1246.  
  1247.     case OP_NULL:
  1248.     if (!(o->op_flags & OPf_KIDS))
  1249.         break;
  1250.     if (o->op_targ != OP_LIST) {
  1251.         mod(cBINOPo->op_first, type);
  1252.         break;
  1253.     }
  1254.     /* FALL THROUGH */
  1255.     case OP_LIST:
  1256.     for (kid = cLISTOPo->op_first; kid; kid = kid->op_sibling)
  1257.         mod(kid, type);
  1258.     break;
  1259.     }
  1260.     o->op_flags |= OPf_MOD;
  1261.  
  1262.     if (type == OP_AASSIGN || type == OP_SASSIGN)
  1263.     o->op_flags |= OPf_SPECIAL|OPf_REF;
  1264.     else if (!type) {
  1265.     o->op_private |= OPpLVAL_INTRO;
  1266.     o->op_flags &= ~OPf_SPECIAL;
  1267.     PL_hints |= HINT_BLOCK_SCOPE;
  1268.     }
  1269.     else if (type != OP_GREPSTART && type != OP_ENTERSUB)
  1270.     o->op_flags |= OPf_REF;
  1271.     return o;
  1272. }
  1273.  
  1274. static bool
  1275. scalar_mod_type(OP *o, I32 type)
  1276. {
  1277.     switch (type) {
  1278.     case OP_SASSIGN:
  1279.     if (o->op_type == OP_RV2GV)
  1280.         return FALSE;
  1281.     /* FALL THROUGH */
  1282.     case OP_PREINC:
  1283.     case OP_PREDEC:
  1284.     case OP_POSTINC:
  1285.     case OP_POSTDEC:
  1286.     case OP_I_PREINC:
  1287.     case OP_I_PREDEC:
  1288.     case OP_I_POSTINC:
  1289.     case OP_I_POSTDEC:
  1290.     case OP_POW:
  1291.     case OP_MULTIPLY:
  1292.     case OP_DIVIDE:
  1293.     case OP_MODULO:
  1294.     case OP_REPEAT:
  1295.     case OP_ADD:
  1296.     case OP_SUBTRACT:
  1297.     case OP_I_MULTIPLY:
  1298.     case OP_I_DIVIDE:
  1299.     case OP_I_MODULO:
  1300.     case OP_I_ADD:
  1301.     case OP_I_SUBTRACT:
  1302.     case OP_LEFT_SHIFT:
  1303.     case OP_RIGHT_SHIFT:
  1304.     case OP_BIT_AND:
  1305.     case OP_BIT_XOR:
  1306.     case OP_BIT_OR:
  1307.     case OP_CONCAT:
  1308.     case OP_SUBST:
  1309.     case OP_TRANS:
  1310.     case OP_READ:
  1311.     case OP_SYSREAD:
  1312.     case OP_RECV:
  1313.     case OP_ANDASSIGN:    /* may work later */
  1314.     case OP_ORASSIGN:    /* may work later */
  1315.     return TRUE;
  1316.     default:
  1317.     return FALSE;
  1318.     }
  1319. }
  1320.  
  1321. OP *
  1322. refkids(OP *o, I32 type)
  1323. {
  1324.     OP *kid;
  1325.     if (o && o->op_flags & OPf_KIDS) {
  1326.     for (kid = cLISTOPo->op_first; kid; kid = kid->op_sibling)
  1327.         ref(kid, type);
  1328.     }
  1329.     return o;
  1330. }
  1331.  
  1332. OP *
  1333. ref(OP *o, I32 type)
  1334. {
  1335.     OP *kid;
  1336.  
  1337.     if (!o || PL_error_count)
  1338.     return o;
  1339.  
  1340.     switch (o->op_type) {
  1341.     case OP_ENTERSUB:
  1342.     if ((type == OP_DEFINED || type == OP_LOCK) &&
  1343.         !(o->op_flags & OPf_STACKED)) {
  1344.         o->op_type = OP_RV2CV;             /* entersub => rv2cv */
  1345.         o->op_ppaddr = ppaddr[OP_RV2CV];
  1346.         assert(cUNOPo->op_first->op_type == OP_NULL);
  1347.         null(((LISTOP*)cUNOPo->op_first)->op_first);    /* disable pushmark */
  1348.         o->op_flags |= OPf_SPECIAL;
  1349.     }
  1350.     break;
  1351.  
  1352.     case OP_COND_EXPR:
  1353.     for (kid = cUNOPo->op_first->op_sibling; kid; kid = kid->op_sibling)
  1354.         ref(kid, type);
  1355.     break;
  1356.     case OP_RV2SV:
  1357.     ref(cUNOPo->op_first, o->op_type);
  1358.     /* FALL THROUGH */
  1359.     case OP_PADSV:
  1360.     if (type == OP_RV2SV || type == OP_RV2AV || type == OP_RV2HV) {
  1361.         o->op_private |= (type == OP_RV2AV ? OPpDEREF_AV
  1362.                   : type == OP_RV2HV ? OPpDEREF_HV
  1363.                   : OPpDEREF_SV);
  1364.         o->op_flags |= OPf_MOD;
  1365.     }
  1366.     break;
  1367.       
  1368.     case OP_THREADSV:
  1369.     o->op_flags |= OPf_MOD;        /* XXX ??? */
  1370.     break;
  1371.  
  1372.     case OP_RV2AV:
  1373.     case OP_RV2HV:
  1374.     o->op_flags |= OPf_REF;
  1375.     /* FALL THROUGH */
  1376.     case OP_RV2GV:
  1377.     ref(cUNOPo->op_first, o->op_type);
  1378.     break;
  1379.  
  1380.     case OP_PADAV:
  1381.     case OP_PADHV:
  1382.     o->op_flags |= OPf_REF;
  1383.     break;
  1384.  
  1385.     case OP_SCALAR:
  1386.     case OP_NULL:
  1387.     if (!(o->op_flags & OPf_KIDS))
  1388.         break;
  1389.     ref(cBINOPo->op_first, type);
  1390.     break;
  1391.     case OP_AELEM:
  1392.     case OP_HELEM:
  1393.     ref(cBINOPo->op_first, o->op_type);
  1394.     if (type == OP_RV2SV || type == OP_RV2AV || type == OP_RV2HV) {
  1395.         o->op_private |= (type == OP_RV2AV ? OPpDEREF_AV
  1396.                   : type == OP_RV2HV ? OPpDEREF_HV
  1397.                   : OPpDEREF_SV);
  1398.         o->op_flags |= OPf_MOD;
  1399.     }
  1400.     break;
  1401.  
  1402.     case OP_SCOPE:
  1403.     case OP_LEAVE:
  1404.     case OP_ENTER:
  1405.     case OP_LIST:
  1406.     if (!(o->op_flags & OPf_KIDS))
  1407.         break;
  1408.     ref(cLISTOPo->op_last, type);
  1409.     break;
  1410.     default:
  1411.     break;
  1412.     }
  1413.     return scalar(o);
  1414.  
  1415. }
  1416.  
  1417. OP *
  1418. my(OP *o)
  1419. {
  1420.     OP *kid;
  1421.     I32 type;
  1422.  
  1423.     if (!o || PL_error_count)
  1424.     return o;
  1425.  
  1426.     type = o->op_type;
  1427.     if (type == OP_LIST) {
  1428.     for (kid = cLISTOPo->op_first; kid; kid = kid->op_sibling)
  1429.         my(kid);
  1430.     } else if (type == OP_UNDEF) {
  1431.     return o;
  1432.     } else if (type != OP_PADSV &&
  1433.          type != OP_PADAV &&
  1434.          type != OP_PADHV &&
  1435.          type != OP_PUSHMARK)
  1436.     {
  1437.     yyerror(form("Can't declare %s in my", op_desc[o->op_type]));
  1438.     return o;
  1439.     }
  1440.     o->op_flags |= OPf_MOD;
  1441.     o->op_private |= OPpLVAL_INTRO;
  1442.     return o;
  1443. }
  1444.  
  1445. OP *
  1446. sawparens(OP *o)
  1447. {
  1448.     if (o)
  1449.     o->op_flags |= OPf_PARENS;
  1450.     return o;
  1451. }
  1452.  
  1453. OP *
  1454. bind_match(I32 type, OP *left, OP *right)
  1455. {
  1456.     OP *o;
  1457.  
  1458.     if (PL_dowarn &&
  1459.     (left->op_type == OP_RV2AV ||
  1460.      left->op_type == OP_RV2HV ||
  1461.      left->op_type == OP_PADAV ||
  1462.      left->op_type == OP_PADHV)) {
  1463.     char *desc = op_desc[(right->op_type == OP_SUBST ||
  1464.                   right->op_type == OP_TRANS)
  1465.                  ? right->op_type : OP_MATCH];
  1466.     char *sample = ((left->op_type == OP_RV2AV ||
  1467.              left->op_type == OP_PADAV)
  1468.             ? "@array" : "%hash");
  1469.     warn("Applying %s to %s will act on scalar(%s)", desc, sample, sample);
  1470.     }
  1471.  
  1472.     if (right->op_type == OP_MATCH ||
  1473.     right->op_type == OP_SUBST ||
  1474.     right->op_type == OP_TRANS) {
  1475.     right->op_flags |= OPf_STACKED;
  1476.     if (right->op_type != OP_MATCH)
  1477.         left = mod(left, right->op_type);
  1478.     if (right->op_type == OP_TRANS)
  1479.         o = newBINOP(OP_NULL, OPf_STACKED, scalar(left), right);
  1480.     else
  1481.         o = prepend_elem(right->op_type, scalar(left), right);
  1482.     if (type == OP_NOT)
  1483.         return newUNOP(OP_NOT, 0, scalar(o));
  1484.     return o;
  1485.     }
  1486.     else
  1487.     return bind_match(type, left,
  1488.         pmruntime(newPMOP(OP_MATCH, 0), right, Nullop));
  1489. }
  1490.  
  1491. OP *
  1492. invert(OP *o)
  1493. {
  1494.     if (!o)
  1495.     return o;
  1496.     /* XXX need to optimize away NOT NOT here?  Or do we let optimizer do it? */
  1497.     return newUNOP(OP_NOT, OPf_SPECIAL, scalar(o));
  1498. }
  1499.  
  1500. OP *
  1501. scope(OP *o)
  1502. {
  1503.     if (o) {
  1504.     if (o->op_flags & OPf_PARENS || PERLDB_NOOPT || PL_tainting) {
  1505.         o = prepend_elem(OP_LINESEQ, newOP(OP_ENTER, 0), o);
  1506.         o->op_type = OP_LEAVE;
  1507.         o->op_ppaddr = ppaddr[OP_LEAVE];
  1508.     }
  1509.     else {
  1510.         if (o->op_type == OP_LINESEQ) {
  1511.         OP *kid;
  1512.         o->op_type = OP_SCOPE;
  1513.         o->op_ppaddr = ppaddr[OP_SCOPE];
  1514.         kid = ((LISTOP*)o)->op_first;
  1515.         if (kid->op_type == OP_NEXTSTATE || kid->op_type == OP_DBSTATE){
  1516.             SvREFCNT_dec(((COP*)kid)->cop_filegv);
  1517.             null(kid);
  1518.         }
  1519.         }
  1520.         else
  1521.         o = newLISTOP(OP_SCOPE, 0, o, Nullop);
  1522.     }
  1523.     }
  1524.     return o;
  1525. }
  1526.  
  1527. void
  1528. save_hints(void)
  1529. {
  1530.     SAVEI32(PL_hints);
  1531.     SAVESPTR(GvHV(PL_hintgv));
  1532.     GvHV(PL_hintgv) = newHVhv(GvHV(PL_hintgv));
  1533.     SAVEFREESV(GvHV(PL_hintgv));
  1534. }
  1535.  
  1536. int
  1537. block_start(int full)
  1538. {
  1539.     dTHR;
  1540.     int retval = PL_savestack_ix;
  1541.  
  1542.     SAVEI32(PL_comppad_name_floor);
  1543.     if (full) {
  1544.     if ((PL_comppad_name_fill = AvFILLp(PL_comppad_name)) > 0)
  1545.         PL_comppad_name_floor = PL_comppad_name_fill;
  1546.     else
  1547.         PL_comppad_name_floor = 0;
  1548.     }
  1549.     SAVEI32(PL_min_intro_pending);
  1550.     SAVEI32(PL_max_intro_pending);
  1551.     PL_min_intro_pending = 0;
  1552.     SAVEI32(PL_comppad_name_fill);
  1553.     SAVEI32(PL_padix_floor);
  1554.     PL_padix_floor = PL_padix;
  1555.     PL_pad_reset_pending = FALSE;
  1556.     SAVEHINTS();
  1557.     PL_hints &= ~HINT_BLOCK_SCOPE;
  1558.     return retval;
  1559. }
  1560.  
  1561. OP*
  1562. block_end(I32 floor, OP *seq)
  1563. {
  1564.     dTHR;
  1565.     int needblockscope = PL_hints & HINT_BLOCK_SCOPE;
  1566.     OP* retval = scalarseq(seq);
  1567.     LEAVE_SCOPE(floor);
  1568.     PL_pad_reset_pending = FALSE;
  1569.     if (needblockscope)
  1570.     PL_hints |= HINT_BLOCK_SCOPE; /* propagate out */
  1571.     pad_leavemy(PL_comppad_name_fill);
  1572.     PL_cop_seqmax++;
  1573.     return retval;
  1574. }
  1575.  
  1576. STATIC OP *
  1577. newDEFSVOP(void)
  1578. {
  1579. #ifdef USE_THREADS
  1580.     OP *o = newOP(OP_THREADSV, 0);
  1581.     o->op_targ = find_threadsv("_");
  1582.     return o;
  1583. #else
  1584.     return newSVREF(newGVOP(OP_GV, 0, PL_defgv));
  1585. #endif /* USE_THREADS */
  1586. }
  1587.  
  1588. void
  1589. newPROG(OP *o)
  1590. {
  1591.     dTHR;
  1592.     if (PL_in_eval) {
  1593.     PL_eval_root = newUNOP(OP_LEAVEEVAL, ((PL_in_eval & 4) ? OPf_SPECIAL : 0), o);
  1594.     PL_eval_start = linklist(PL_eval_root);
  1595.     PL_eval_root->op_next = 0;
  1596.     peep(PL_eval_start);
  1597.     }
  1598.     else {
  1599.     if (!o)
  1600.         return;
  1601.     PL_main_root = scope(sawparens(scalarvoid(o)));
  1602.     PL_curcop = &PL_compiling;
  1603.     PL_main_start = LINKLIST(PL_main_root);
  1604.     PL_main_root->op_next = 0;
  1605.     peep(PL_main_start);
  1606.     PL_compcv = 0;
  1607.  
  1608.     /* Register with debugger */
  1609.     if (PERLDB_INTER) {
  1610.         CV *cv = perl_get_cv("DB::postponed", FALSE);
  1611.         if (cv) {
  1612.         dSP;
  1613.         PUSHMARK(SP);
  1614.         XPUSHs((SV*)PL_compiling.cop_filegv);
  1615.         PUTBACK;
  1616.         perl_call_sv((SV*)cv, G_DISCARD);
  1617.         }
  1618.     }
  1619.     }
  1620. }
  1621.  
  1622. OP *
  1623. localize(OP *o, I32 lex)
  1624. {
  1625.     if (o->op_flags & OPf_PARENS)
  1626.     list(o);
  1627.     else {
  1628.     if (PL_dowarn && PL_bufptr > PL_oldbufptr && PL_bufptr[-1] == ',') {
  1629.         char *s;
  1630.         for (s = PL_bufptr; *s && (isALNUM(*s) || strchr("@$%, ",*s)); s++) ;
  1631.         if (*s == ';' || *s == '=')
  1632.         warn("Parens missing around \"%s\" list", lex ? "my" : "local");
  1633.     }
  1634.     }
  1635.     PL_in_my = FALSE;
  1636.     PL_in_my_stash = Nullhv;
  1637.     if (lex)
  1638.     return my(o);
  1639.     else
  1640.     return mod(o, OP_NULL);        /* a bit kludgey */
  1641. }
  1642.  
  1643. OP *
  1644. jmaybe(OP *o)
  1645. {
  1646.     if (o->op_type == OP_LIST) {
  1647.     OP *o2;
  1648. #ifdef USE_THREADS
  1649.     o2 = newOP(OP_THREADSV, 0);
  1650.     o2->op_targ = find_threadsv(";");
  1651. #else
  1652.     o2 = newSVREF(newGVOP(OP_GV, 0, gv_fetchpv(";", TRUE, SVt_PV))),
  1653. #endif /* USE_THREADS */
  1654.     o = convert(OP_JOIN, 0, prepend_elem(OP_LIST, o2, o));
  1655.     }
  1656.     return o;
  1657. }
  1658.  
  1659. OP *
  1660. fold_constants(register OP *o)
  1661. {
  1662.     dTHR;
  1663.     register OP *curop;
  1664.     I32 type = o->op_type;
  1665.     SV *sv;
  1666.  
  1667.     if (opargs[type] & OA_RETSCALAR)
  1668.     scalar(o);
  1669.     if (opargs[type] & OA_TARGET)
  1670.     o->op_targ = pad_alloc(type, SVs_PADTMP);
  1671.  
  1672.     if ((opargs[type] & OA_OTHERINT) && (PL_hints & HINT_INTEGER))
  1673.     o->op_ppaddr = ppaddr[type = ++(o->op_type)];
  1674.  
  1675.     if (!(opargs[type] & OA_FOLDCONST))
  1676.     goto nope;
  1677.  
  1678.     switch (type) {
  1679.     case OP_SPRINTF:
  1680.     case OP_UCFIRST:
  1681.     case OP_LCFIRST:
  1682.     case OP_UC:
  1683.     case OP_LC:
  1684.     case OP_SLT:
  1685.     case OP_SGT:
  1686.     case OP_SLE:
  1687.     case OP_SGE:
  1688.     case OP_SCMP:
  1689.  
  1690.     if (o->op_private & OPpLOCALE)
  1691.         goto nope;
  1692.     }
  1693.  
  1694.     if (PL_error_count)
  1695.     goto nope;        /* Don't try to run w/ errors */
  1696.  
  1697.     for (curop = LINKLIST(o); curop != o; curop = LINKLIST(curop)) {
  1698.     if (curop->op_type != OP_CONST &&
  1699.         curop->op_type != OP_LIST &&
  1700.         curop->op_type != OP_SCALAR &&
  1701.         curop->op_type != OP_NULL &&
  1702.         curop->op_type != OP_PUSHMARK) {
  1703.         goto nope;
  1704.     }
  1705.     }
  1706.  
  1707.     curop = LINKLIST(o);
  1708.     o->op_next = 0;
  1709.     PL_op = curop;
  1710.     CALLRUNOPS();
  1711.     sv = *(PL_stack_sp--);
  1712.     if (o->op_targ && sv == PAD_SV(o->op_targ))    /* grab pad temp? */
  1713.     pad_swipe(o->op_targ);
  1714.     else if (SvTEMP(sv)) {            /* grab mortal temp? */
  1715.     (void)SvREFCNT_inc(sv);
  1716.     SvTEMP_off(sv);
  1717.     }
  1718.     op_free(o);
  1719.     if (type == OP_RV2GV)
  1720.     return newGVOP(OP_GV, 0, (GV*)sv);
  1721.     else {
  1722.     /* try to smush double to int, but don't smush -2.0 to -2 */
  1723.     if ((SvFLAGS(sv) & (SVf_IOK|SVf_NOK|SVf_POK)) == SVf_NOK &&
  1724.         type != OP_NEGATE)
  1725.     {
  1726.         IV iv = SvIV(sv);
  1727.         if ((double)iv == SvNV(sv)) {
  1728.         SvREFCNT_dec(sv);
  1729.         sv = newSViv(iv);
  1730.         }
  1731.         else
  1732.         SvIOK_off(sv);            /* undo SvIV() damage */
  1733.     }
  1734.     return newSVOP(OP_CONST, 0, sv);
  1735.     }
  1736.  
  1737.   nope:
  1738.     if (!(opargs[type] & OA_OTHERINT))
  1739.     return o;
  1740.  
  1741.     if (!(PL_hints & HINT_INTEGER)) {
  1742.     if (type == OP_DIVIDE || !(o->op_flags & OPf_KIDS))
  1743.         return o;
  1744.  
  1745.     for (curop = ((UNOP*)o)->op_first; curop; curop = curop->op_sibling) {
  1746.         if (curop->op_type == OP_CONST) {
  1747.         if (SvIOK(((SVOP*)curop)->op_sv))
  1748.             continue;
  1749.         return o;
  1750.         }
  1751.         if (opargs[curop->op_type] & OA_RETINTEGER)
  1752.         continue;
  1753.         return o;
  1754.     }
  1755.     o->op_ppaddr = ppaddr[++(o->op_type)];
  1756.     }
  1757.  
  1758.     return o;
  1759. }
  1760.  
  1761. OP *
  1762. gen_constant_list(register OP *o)
  1763. {
  1764.     dTHR;
  1765.     register OP *curop;
  1766.     I32 oldtmps_floor = PL_tmps_floor;
  1767.  
  1768.     list(o);
  1769.     if (PL_error_count)
  1770.     return o;        /* Don't attempt to run with errors */
  1771.  
  1772.     PL_op = curop = LINKLIST(o);
  1773.     o->op_next = 0;
  1774.     pp_pushmark(ARGS);
  1775.     CALLRUNOPS();
  1776.     PL_op = curop;
  1777.     pp_anonlist(ARGS);
  1778.     PL_tmps_floor = oldtmps_floor;
  1779.  
  1780.     o->op_type = OP_RV2AV;
  1781.     o->op_ppaddr = ppaddr[OP_RV2AV];
  1782.     curop = ((UNOP*)o)->op_first;
  1783.     ((UNOP*)o)->op_first = newSVOP(OP_CONST, 0, SvREFCNT_inc(*PL_stack_sp--));
  1784.     op_free(curop);
  1785.     linklist(o);
  1786.     return list(o);
  1787. }
  1788.  
  1789. OP *
  1790. convert(I32 type, I32 flags, OP *o)
  1791. {
  1792.     OP *kid;
  1793.     OP *last = 0;
  1794.  
  1795.     if (!o || o->op_type != OP_LIST)
  1796.     o = newLISTOP(OP_LIST, 0, o, Nullop);
  1797.     else
  1798.     o->op_flags &= ~OPf_WANT;
  1799.  
  1800.     if (!(opargs[type] & OA_MARK))
  1801.     null(cLISTOPo->op_first);
  1802.  
  1803.     o->op_type = type;
  1804.     o->op_ppaddr = ppaddr[type];
  1805.     o->op_flags |= flags;
  1806.  
  1807.     o = CHECKOP(type, o);
  1808.     if (o->op_type != type)
  1809.     return o;
  1810.  
  1811.     if (cLISTOPo->op_children < 7) {
  1812.     /* XXX do we really need to do this if we're done appending?? */
  1813.     for (kid = cLISTOPo->op_first; kid; kid = kid->op_sibling)
  1814.         last = kid;
  1815.     cLISTOPo->op_last = last;    /* in case check substituted last arg */
  1816.     }
  1817.  
  1818.     return fold_constants(o);
  1819. }
  1820.  
  1821. /* List constructors */
  1822.  
  1823. OP *
  1824. append_elem(I32 type, OP *first, OP *last)
  1825. {
  1826.     if (!first)
  1827.     return last;
  1828.  
  1829.     if (!last)
  1830.     return first;
  1831.  
  1832.     if (first->op_type != type || type==OP_LIST && first->op_flags & OPf_PARENS)
  1833.         return newLISTOP(type, 0, first, last);
  1834.  
  1835.     if (first->op_flags & OPf_KIDS)
  1836.     ((LISTOP*)first)->op_last->op_sibling = last;
  1837.     else {
  1838.     first->op_flags |= OPf_KIDS;
  1839.     ((LISTOP*)first)->op_first = last;
  1840.     }
  1841.     ((LISTOP*)first)->op_last = last;
  1842.     ((LISTOP*)first)->op_children++;
  1843.     return first;
  1844. }
  1845.  
  1846. OP *
  1847. append_list(I32 type, LISTOP *first, LISTOP *last)
  1848. {
  1849.     if (!first)
  1850.     return (OP*)last;
  1851.  
  1852.     if (!last)
  1853.     return (OP*)first;
  1854.  
  1855.     if (first->op_type != type)
  1856.     return prepend_elem(type, (OP*)first, (OP*)last);
  1857.  
  1858.     if (last->op_type != type)
  1859.     return append_elem(type, (OP*)first, (OP*)last);
  1860.  
  1861.     first->op_last->op_sibling = last->op_first;
  1862.     first->op_last = last->op_last;
  1863.     first->op_children += last->op_children;
  1864.     if (first->op_children)
  1865.     last->op_flags |= OPf_KIDS;
  1866.  
  1867.     Safefree(last);
  1868.     return (OP*)first;
  1869. }
  1870.  
  1871. OP *
  1872. prepend_elem(I32 type, OP *first, OP *last)
  1873. {
  1874.     if (!first)
  1875.     return last;
  1876.  
  1877.     if (!last)
  1878.     return first;
  1879.  
  1880.     if (last->op_type == type) {
  1881.     if (type == OP_LIST) {    /* already a PUSHMARK there */
  1882.         first->op_sibling = ((LISTOP*)last)->op_first->op_sibling;
  1883.         ((LISTOP*)last)->op_first->op_sibling = first;
  1884.     }
  1885.     else {
  1886.         if (!(last->op_flags & OPf_KIDS)) {
  1887.         ((LISTOP*)last)->op_last = first;
  1888.         last->op_flags |= OPf_KIDS;
  1889.         }
  1890.         first->op_sibling = ((LISTOP*)last)->op_first;
  1891.         ((LISTOP*)last)->op_first = first;
  1892.     }
  1893.     ((LISTOP*)last)->op_children++;
  1894.     return last;
  1895.     }
  1896.  
  1897.     return newLISTOP(type, 0, first, last);
  1898. }
  1899.  
  1900. /* Constructors */
  1901.  
  1902. OP *
  1903. newNULLLIST(void)
  1904. {
  1905.     return newOP(OP_STUB, 0);
  1906. }
  1907.  
  1908. OP *
  1909. force_list(OP *o)
  1910. {
  1911.     if (!o || o->op_type != OP_LIST)
  1912.     o = newLISTOP(OP_LIST, 0, o, Nullop);
  1913.     null(o);
  1914.     return o;
  1915. }
  1916.  
  1917. OP *
  1918. newLISTOP(I32 type, I32 flags, OP *first, OP *last)
  1919. {
  1920.     LISTOP *listop;
  1921.  
  1922.     Newz(1101, listop, 1, LISTOP);
  1923.  
  1924.     listop->op_type = type;
  1925.     listop->op_ppaddr = ppaddr[type];
  1926.     listop->op_children = (first != 0) + (last != 0);
  1927.     listop->op_flags = flags;
  1928.  
  1929.     if (!last && first)
  1930.     last = first;
  1931.     else if (!first && last)
  1932.     first = last;
  1933.     else if (first)
  1934.     first->op_sibling = last;
  1935.     listop->op_first = first;
  1936.     listop->op_last = last;
  1937.     if (type == OP_LIST) {
  1938.     OP* pushop;
  1939.     pushop = newOP(OP_PUSHMARK, 0);
  1940.     pushop->op_sibling = first;
  1941.     listop->op_first = pushop;
  1942.     listop->op_flags |= OPf_KIDS;
  1943.     if (!last)
  1944.         listop->op_last = pushop;
  1945.     }
  1946.     else if (listop->op_children)
  1947.     listop->op_flags |= OPf_KIDS;
  1948.  
  1949.     return (OP*)listop;
  1950. }
  1951.  
  1952. OP *
  1953. newOP(I32 type, I32 flags)
  1954. {
  1955.     OP *o;
  1956.     Newz(1101, o, 1, OP);
  1957.     o->op_type = type;
  1958.     o->op_ppaddr = ppaddr[type];
  1959.     o->op_flags = flags;
  1960.  
  1961.     o->op_next = o;
  1962.     o->op_private = 0 + (flags >> 8);
  1963.     if (opargs[type] & OA_RETSCALAR)
  1964.     scalar(o);
  1965.     if (opargs[type] & OA_TARGET)
  1966.     o->op_targ = pad_alloc(type, SVs_PADTMP);
  1967.     return CHECKOP(type, o);
  1968. }
  1969.  
  1970. OP *
  1971. newUNOP(I32 type, I32 flags, OP *first)
  1972. {
  1973.     UNOP *unop;
  1974.  
  1975.     if (!first)
  1976.     first = newOP(OP_STUB, 0);
  1977.     if (opargs[type] & OA_MARK)
  1978.     first = force_list(first);
  1979.  
  1980.     Newz(1101, unop, 1, UNOP);
  1981.     unop->op_type = type;
  1982.     unop->op_ppaddr = ppaddr[type];
  1983.     unop->op_first = first;
  1984.     unop->op_flags = flags | OPf_KIDS;
  1985.     unop->op_private = 1 | (flags >> 8);
  1986.     unop = (UNOP*) CHECKOP(type, unop);
  1987.     if (unop->op_next)
  1988.     return (OP*)unop;
  1989.  
  1990.     return fold_constants((OP *) unop);
  1991. }
  1992.  
  1993. OP *
  1994. newBINOP(I32 type, I32 flags, OP *first, OP *last)
  1995. {
  1996.     BINOP *binop;
  1997.     Newz(1101, binop, 1, BINOP);
  1998.  
  1999.     if (!first)
  2000.     first = newOP(OP_NULL, 0);
  2001.  
  2002.     binop->op_type = type;
  2003.     binop->op_ppaddr = ppaddr[type];
  2004.     binop->op_first = first;
  2005.     binop->op_flags = flags | OPf_KIDS;
  2006.     if (!last) {
  2007.     last = first;
  2008.     binop->op_private = 1 | (flags >> 8);
  2009.     }
  2010.     else {
  2011.     binop->op_private = 2 | (flags >> 8);
  2012.     first->op_sibling = last;
  2013.     }
  2014.  
  2015.     binop = (BINOP*)CHECKOP(type, binop);
  2016.     if (binop->op_next)
  2017.     return (OP*)binop;
  2018.  
  2019.     binop->op_last = last = binop->op_first->op_sibling;
  2020.  
  2021.     return fold_constants((OP *)binop);
  2022. }
  2023.  
  2024. OP *
  2025. pmtrans(OP *o, OP *expr, OP *repl)
  2026. {
  2027.     SV *tstr = ((SVOP*)expr)->op_sv;
  2028.     SV *rstr = ((SVOP*)repl)->op_sv;
  2029.     STRLEN tlen;
  2030.     STRLEN rlen;
  2031.     register U8 *t = (U8*)SvPV(tstr, tlen);
  2032.     register U8 *r = (U8*)SvPV(rstr, rlen);
  2033.     register I32 i;
  2034.     register I32 j;
  2035.     I32 Delete;
  2036.     I32 complement;
  2037.     I32 squash;
  2038.     register short *tbl;
  2039.  
  2040.     tbl = (short*)cPVOPo->op_pv;
  2041.     complement    = o->op_private & OPpTRANS_COMPLEMENT;
  2042.     Delete    = o->op_private & OPpTRANS_DELETE;
  2043.     squash    = o->op_private & OPpTRANS_SQUASH;
  2044.  
  2045.     if (complement) {
  2046.     Zero(tbl, 256, short);
  2047.     for (i = 0; i < tlen; i++)
  2048.         tbl[t[i]] = -1;
  2049.     for (i = 0, j = 0; i < 256; i++) {
  2050.         if (!tbl[i]) {
  2051.         if (j >= rlen) {
  2052.             if (Delete)
  2053.             tbl[i] = -2;
  2054.             else if (rlen)
  2055.             tbl[i] = r[j-1];
  2056.             else
  2057.             tbl[i] = i;
  2058.         }
  2059.         else
  2060.             tbl[i] = r[j++];
  2061.         }
  2062.     }
  2063.     }
  2064.     else {
  2065.     if (!rlen && !Delete) {
  2066.         r = t; rlen = tlen;
  2067.         if (!squash)
  2068.         o->op_private |= OPpTRANS_COUNTONLY;
  2069.     }
  2070.     for (i = 0; i < 256; i++)
  2071.         tbl[i] = -1;
  2072.     for (i = 0, j = 0; i < tlen; i++,j++) {
  2073.         if (j >= rlen) {
  2074.         if (Delete) {
  2075.             if (tbl[t[i]] == -1)
  2076.             tbl[t[i]] = -2;
  2077.             continue;
  2078.         }
  2079.         --j;
  2080.         }
  2081.         if (tbl[t[i]] == -1)
  2082.         tbl[t[i]] = r[j];
  2083.     }
  2084.     }
  2085.     op_free(expr);
  2086.     op_free(repl);
  2087.  
  2088.     return o;
  2089. }
  2090.  
  2091. OP *
  2092. newPMOP(I32 type, I32 flags)
  2093. {
  2094.     dTHR;
  2095.     PMOP *pmop;
  2096.  
  2097.     Newz(1101, pmop, 1, PMOP);
  2098.     pmop->op_type = type;
  2099.     pmop->op_ppaddr = ppaddr[type];
  2100.     pmop->op_flags = flags;
  2101.     pmop->op_private = 0 | (flags >> 8);
  2102.  
  2103.     if (PL_hints & HINT_RE_TAINT)
  2104.     pmop->op_pmpermflags |= PMf_RETAINT;
  2105.     if (PL_hints & HINT_LOCALE)
  2106.     pmop->op_pmpermflags |= PMf_LOCALE;
  2107.     pmop->op_pmflags = pmop->op_pmpermflags;
  2108.  
  2109.     /* link into pm list */
  2110.     if (type != OP_TRANS && PL_curstash) {
  2111.     pmop->op_pmnext = HvPMROOT(PL_curstash);
  2112.     HvPMROOT(PL_curstash) = pmop;
  2113.     }
  2114.  
  2115.     return (OP*)pmop;
  2116. }
  2117.  
  2118. OP *
  2119. pmruntime(OP *o, OP *expr, OP *repl)
  2120. {
  2121.     dTHR;
  2122.     PMOP *pm;
  2123.     LOGOP *rcop;
  2124.     I32 repl_has_vars = 0;
  2125.  
  2126.     if (o->op_type == OP_TRANS)
  2127.     return pmtrans(o, expr, repl);
  2128.  
  2129.     PL_hints |= HINT_BLOCK_SCOPE;
  2130.     pm = (PMOP*)o;
  2131.  
  2132.     if (expr->op_type == OP_CONST) {
  2133.     STRLEN plen;
  2134.     SV *pat = ((SVOP*)expr)->op_sv;
  2135.     char *p = SvPV(pat, plen);
  2136.     if ((o->op_flags & OPf_SPECIAL) && strEQ(p, " ")) {
  2137.         sv_setpvn(pat, "\\s+", 3);
  2138.         p = SvPV(pat, plen);
  2139.         pm->op_pmflags |= PMf_SKIPWHITE;
  2140.     }
  2141.     pm->op_pmregexp = CALLREGCOMP(p, p + plen, pm);
  2142.     if (strEQ("\\s+", pm->op_pmregexp->precomp))
  2143.         pm->op_pmflags |= PMf_WHITE;
  2144.     op_free(expr);
  2145.     }
  2146.     else {
  2147.     if (pm->op_pmflags & PMf_KEEP || !(PL_hints & HINT_RE_EVAL))
  2148.         expr = newUNOP((!(PL_hints & HINT_RE_EVAL) 
  2149.                 ? OP_REGCRESET
  2150.                 : OP_REGCMAYBE),0,expr);
  2151.  
  2152.     Newz(1101, rcop, 1, LOGOP);
  2153.     rcop->op_type = OP_REGCOMP;
  2154.     rcop->op_ppaddr = ppaddr[OP_REGCOMP];
  2155.     rcop->op_first = scalar(expr);
  2156.     rcop->op_flags |= ((PL_hints & HINT_RE_EVAL) 
  2157.                ? (OPf_SPECIAL | OPf_KIDS)
  2158.                : OPf_KIDS);
  2159.     rcop->op_private = 1;
  2160.     rcop->op_other = o;
  2161.  
  2162.     /* establish postfix order */
  2163.     if (pm->op_pmflags & PMf_KEEP || !(PL_hints & HINT_RE_EVAL)) {
  2164.         LINKLIST(expr);
  2165.         rcop->op_next = expr;
  2166.         ((UNOP*)expr)->op_first->op_next = (OP*)rcop;
  2167.     }
  2168.     else {
  2169.         rcop->op_next = LINKLIST(expr);
  2170.         expr->op_next = (OP*)rcop;
  2171.     }
  2172.  
  2173.     prepend_elem(o->op_type, scalar((OP*)rcop), o);
  2174.     }
  2175.  
  2176.     if (repl) {
  2177.     OP *curop;
  2178.     if (pm->op_pmflags & PMf_EVAL)
  2179.         curop = 0;
  2180. #ifdef USE_THREADS
  2181.     else if (repl->op_type == OP_THREADSV
  2182.          && strchr("&`'123456789+",
  2183.                PL_threadsv_names[repl->op_targ]))
  2184.     {
  2185.         curop = 0;
  2186.     }
  2187. #endif /* USE_THREADS */
  2188.     else if (repl->op_type == OP_CONST)
  2189.         curop = repl;
  2190.     else {
  2191.         OP *lastop = 0;
  2192.         for (curop = LINKLIST(repl); curop!=repl; curop = LINKLIST(curop)) {
  2193.         if (opargs[curop->op_type] & OA_DANGEROUS) {
  2194. #ifdef USE_THREADS
  2195.             if (curop->op_type == OP_THREADSV) {
  2196.             repl_has_vars = 1;
  2197.             if (strchr("&`'123456789+", curop->op_private))
  2198.                 break;
  2199.             }
  2200. #else
  2201.             if (curop->op_type == OP_GV) {
  2202.             GV *gv = ((GVOP*)curop)->op_gv;
  2203.             repl_has_vars = 1;
  2204.             if (strchr("&`'123456789+", *GvENAME(gv)))
  2205.                 break;
  2206.             }
  2207. #endif /* USE_THREADS */
  2208.             else if (curop->op_type == OP_RV2CV)
  2209.             break;
  2210.             else if (curop->op_type == OP_RV2SV ||
  2211.                  curop->op_type == OP_RV2AV ||
  2212.                  curop->op_type == OP_RV2HV ||
  2213.                  curop->op_type == OP_RV2GV) {
  2214.             if (lastop && lastop->op_type != OP_GV)    /*funny deref?*/
  2215.                 break;
  2216.             }
  2217.             else if (curop->op_type == OP_PADSV ||
  2218.                  curop->op_type == OP_PADAV ||
  2219.                  curop->op_type == OP_PADHV ||
  2220.                  curop->op_type == OP_PADANY) {
  2221.             repl_has_vars = 1;
  2222.             }
  2223.             else if (curop->op_type == OP_PUSHRE)
  2224.             ; /* Okay here, dangerous in newASSIGNOP */
  2225.             else
  2226.             break;
  2227.         }
  2228.         lastop = curop;
  2229.         }
  2230.     }
  2231.     if (curop == repl
  2232.         && !(repl_has_vars 
  2233.          && (!pm->op_pmregexp 
  2234.              || pm->op_pmregexp->reganch & ROPT_EVAL_SEEN))) {
  2235.         pm->op_pmflags |= PMf_CONST;    /* const for long enough */
  2236.         pm->op_pmpermflags |= PMf_CONST;    /* const for long enough */
  2237.         prepend_elem(o->op_type, scalar(repl), o);
  2238.     }
  2239.     else {
  2240.         if (curop == repl && !pm->op_pmregexp) { /* Has variables. */
  2241.         pm->op_pmflags |= PMf_MAYBE_CONST;
  2242.         pm->op_pmpermflags |= PMf_MAYBE_CONST;
  2243.         }
  2244.         Newz(1101, rcop, 1, LOGOP);
  2245.         rcop->op_type = OP_SUBSTCONT;
  2246.         rcop->op_ppaddr = ppaddr[OP_SUBSTCONT];
  2247.         rcop->op_first = scalar(repl);
  2248.         rcop->op_flags |= OPf_KIDS;
  2249.         rcop->op_private = 1;
  2250.         rcop->op_other = o;
  2251.  
  2252.         /* establish postfix order */
  2253.         rcop->op_next = LINKLIST(repl);
  2254.         repl->op_next = (OP*)rcop;
  2255.  
  2256.         pm->op_pmreplroot = scalar((OP*)rcop);
  2257.         pm->op_pmreplstart = LINKLIST(rcop);
  2258.         rcop->op_next = 0;
  2259.     }
  2260.     }
  2261.  
  2262.     return (OP*)pm;
  2263. }
  2264.  
  2265. OP *
  2266. newSVOP(I32 type, I32 flags, SV *sv)
  2267. {
  2268.     SVOP *svop;
  2269.     Newz(1101, svop, 1, SVOP);
  2270.     svop->op_type = type;
  2271.     svop->op_ppaddr = ppaddr[type];
  2272.     svop->op_sv = sv;
  2273.     svop->op_next = (OP*)svop;
  2274.     svop->op_flags = flags;
  2275.     if (opargs[type] & OA_RETSCALAR)
  2276.     scalar((OP*)svop);
  2277.     if (opargs[type] & OA_TARGET)
  2278.     svop->op_targ = pad_alloc(type, SVs_PADTMP);
  2279.     return CHECKOP(type, svop);
  2280. }
  2281.  
  2282. OP *
  2283. newGVOP(I32 type, I32 flags, GV *gv)
  2284. {
  2285.     dTHR;
  2286.     GVOP *gvop;
  2287.     Newz(1101, gvop, 1, GVOP);
  2288.     gvop->op_type = type;
  2289.     gvop->op_ppaddr = ppaddr[type];
  2290.     gvop->op_gv = (GV*)SvREFCNT_inc(gv);
  2291.     gvop->op_next = (OP*)gvop;
  2292.     gvop->op_flags = flags;
  2293.     if (opargs[type] & OA_RETSCALAR)
  2294.     scalar((OP*)gvop);
  2295.     if (opargs[type] & OA_TARGET)
  2296.     gvop->op_targ = pad_alloc(type, SVs_PADTMP);
  2297.     return CHECKOP(type, gvop);
  2298. }
  2299.  
  2300. OP *
  2301. newPVOP(I32 type, I32 flags, char *pv)
  2302. {
  2303.     PVOP *pvop;
  2304.     Newz(1101, pvop, 1, PVOP);
  2305.     pvop->op_type = type;
  2306.     pvop->op_ppaddr = ppaddr[type];
  2307.     pvop->op_pv = pv;
  2308.     pvop->op_next = (OP*)pvop;
  2309.     pvop->op_flags = flags;
  2310.     if (opargs[type] & OA_RETSCALAR)
  2311.     scalar((OP*)pvop);
  2312.     if (opargs[type] & OA_TARGET)
  2313.     pvop->op_targ = pad_alloc(type, SVs_PADTMP);
  2314.     return CHECKOP(type, pvop);
  2315. }
  2316.  
  2317. void
  2318. package(OP *o)
  2319. {
  2320.     dTHR;
  2321.     SV *sv;
  2322.  
  2323.     save_hptr(&PL_curstash);
  2324.     save_item(PL_curstname);
  2325.     if (o) {
  2326.     STRLEN len;
  2327.     char *name;
  2328.     sv = cSVOPo->op_sv;
  2329.     name = SvPV(sv, len);
  2330.     PL_curstash = gv_stashpvn(name,len,TRUE);
  2331.     sv_setpvn(PL_curstname, name, len);
  2332.     op_free(o);
  2333.     }
  2334.     else {
  2335.     sv_setpv(PL_curstname,"<none>");
  2336.     PL_curstash = Nullhv;
  2337.     }
  2338.     PL_copline = NOLINE;
  2339.     PL_expect = XSTATE;
  2340. }
  2341.  
  2342. void
  2343. utilize(int aver, I32 floor, OP *version, OP *id, OP *arg)
  2344. {
  2345.     OP *pack;
  2346.     OP *meth;
  2347.     OP *rqop;
  2348.     OP *imop;
  2349.     OP *veop;
  2350.  
  2351.     if (id->op_type != OP_CONST)
  2352.     croak("Module name must be constant");
  2353.  
  2354.     veop = Nullop;
  2355.  
  2356.     if(version != Nullop) {
  2357.     SV *vesv = ((SVOP*)version)->op_sv;
  2358.  
  2359.     if (arg == Nullop && !SvNIOK(vesv)) {
  2360.         arg = version;
  2361.     }
  2362.     else {
  2363.         OP *pack;
  2364.         OP *meth;
  2365.  
  2366.         if (version->op_type != OP_CONST || !SvNIOK(vesv))
  2367.         croak("Version number must be constant number");
  2368.  
  2369.         /* Make copy of id so we don't free it twice */
  2370.         pack = newSVOP(OP_CONST, 0, newSVsv(((SVOP*)id)->op_sv));
  2371.  
  2372.         /* Fake up a method call to VERSION */
  2373.         meth = newSVOP(OP_CONST, 0, newSVpv("VERSION", 7));
  2374.         veop = convert(OP_ENTERSUB, OPf_STACKED|OPf_SPECIAL,
  2375.                 append_elem(OP_LIST,
  2376.                 prepend_elem(OP_LIST, pack, list(version)),
  2377.                 newUNOP(OP_METHOD, 0, meth)));
  2378.     }
  2379.     }
  2380.  
  2381.     /* Fake up an import/unimport */
  2382.     if (arg && arg->op_type == OP_STUB)
  2383.     imop = arg;        /* no import on explicit () */
  2384.     else if(SvNIOK(((SVOP*)id)->op_sv)) {
  2385.     imop = Nullop;        /* use 5.0; */
  2386.     }
  2387.     else {
  2388.     /* Make copy of id so we don't free it twice */
  2389.     pack = newSVOP(OP_CONST, 0, newSVsv(((SVOP*)id)->op_sv));
  2390.     meth = newSVOP(OP_CONST, 0,
  2391.         aver
  2392.         ? newSVpv("import", 6)
  2393.         : newSVpv("unimport", 8)
  2394.         );
  2395.     imop = convert(OP_ENTERSUB, OPf_STACKED|OPf_SPECIAL,
  2396.             append_elem(OP_LIST,
  2397.             prepend_elem(OP_LIST, pack, list(arg)),
  2398.             newUNOP(OP_METHOD, 0, meth)));
  2399.     }
  2400.  
  2401.     /* Fake up a require */
  2402.     rqop = newUNOP(OP_REQUIRE, 0, id);
  2403.  
  2404.     /* Fake up the BEGIN {}, which does its thing immediately. */
  2405.     newSUB(floor,
  2406.     newSVOP(OP_CONST, 0, newSVpv("BEGIN", 5)),
  2407.     Nullop,
  2408.     append_elem(OP_LINESEQ,
  2409.         append_elem(OP_LINESEQ,
  2410.             newSTATEOP(0, Nullch, rqop),
  2411.             newSTATEOP(0, Nullch, veop)),
  2412.         newSTATEOP(0, Nullch, imop) ));
  2413.  
  2414.     PL_copline = NOLINE;
  2415.     PL_expect = XSTATE;
  2416. }
  2417.  
  2418. OP *
  2419. newSLICEOP(I32 flags, OP *subscript, OP *listval)
  2420. {
  2421.     return newBINOP(OP_LSLICE, flags,
  2422.         list(force_list(subscript)),
  2423.         list(force_list(listval)) );
  2424. }
  2425.  
  2426. STATIC I32
  2427. list_assignment(register OP *o)
  2428. {
  2429.     if (!o)
  2430.     return TRUE;
  2431.  
  2432.     if (o->op_type == OP_NULL && o->op_flags & OPf_KIDS)
  2433.     o = cUNOPo->op_first;
  2434.  
  2435.     if (o->op_type == OP_COND_EXPR) {
  2436.     I32 t = list_assignment(cCONDOPo->op_first->op_sibling);
  2437.     I32 f = list_assignment(cCONDOPo->op_first->op_sibling->op_sibling);
  2438.  
  2439.     if (t && f)
  2440.         return TRUE;
  2441.     if (t || f)
  2442.         yyerror("Assignment to both a list and a scalar");
  2443.     return FALSE;
  2444.     }
  2445.  
  2446.     if (o->op_type == OP_LIST || o->op_flags & OPf_PARENS ||
  2447.     o->op_type == OP_RV2AV || o->op_type == OP_RV2HV ||
  2448.     o->op_type == OP_ASLICE || o->op_type == OP_HSLICE)
  2449.     return TRUE;
  2450.  
  2451.     if (o->op_type == OP_PADAV || o->op_type == OP_PADHV)
  2452.     return TRUE;
  2453.  
  2454.     if (o->op_type == OP_RV2SV)
  2455.     return FALSE;
  2456.  
  2457.     return FALSE;
  2458. }
  2459.  
  2460. OP *
  2461. newASSIGNOP(I32 flags, OP *left, I32 optype, OP *right)
  2462. {
  2463.     OP *o;
  2464.  
  2465.     if (optype) {
  2466.     if (optype == OP_ANDASSIGN || optype == OP_ORASSIGN) {
  2467.         return newLOGOP(optype, 0,
  2468.         mod(scalar(left), optype),
  2469.         newUNOP(OP_SASSIGN, 0, scalar(right)));
  2470.     }
  2471.     else {
  2472.         return newBINOP(optype, OPf_STACKED,
  2473.         mod(scalar(left), optype), scalar(right));
  2474.     }
  2475.     }
  2476.  
  2477.     if (list_assignment(left)) {
  2478.     dTHR;
  2479.     PL_modcount = 0;
  2480.     PL_eval_start = right;    /* Grandfathering $[ assignment here.  Bletch.*/
  2481.     left = mod(left, OP_AASSIGN);
  2482.     if (PL_eval_start)
  2483.         PL_eval_start = 0;
  2484.     else {
  2485.         op_free(left);
  2486.         op_free(right);
  2487.         return Nullop;
  2488.     }
  2489.     o = newBINOP(OP_AASSIGN, flags,
  2490.         list(force_list(right)),
  2491.         list(force_list(left)) );
  2492.     o->op_private = 0 | (flags >> 8);
  2493.     if (!(left->op_private & OPpLVAL_INTRO)) {
  2494.         OP *curop;
  2495.         OP *lastop = o;
  2496.         PL_generation++;
  2497.         for (curop = LINKLIST(o); curop != o; curop = LINKLIST(curop)) {
  2498.         if (opargs[curop->op_type] & OA_DANGEROUS) {
  2499.             if (curop->op_type == OP_GV) {
  2500.             GV *gv = ((GVOP*)curop)->op_gv;
  2501.             if (gv == PL_defgv || SvCUR(gv) == PL_generation)
  2502.                 break;
  2503.             SvCUR(gv) = PL_generation;
  2504.             }
  2505.             else if (curop->op_type == OP_PADSV ||
  2506.                  curop->op_type == OP_PADAV ||
  2507.                  curop->op_type == OP_PADHV ||
  2508.                  curop->op_type == OP_PADANY) {
  2509.             SV **svp = AvARRAY(PL_comppad_name);
  2510.             SV *sv = svp[curop->op_targ];
  2511.             if (SvCUR(sv) == PL_generation)
  2512.                 break;
  2513.             SvCUR(sv) = PL_generation;    /* (SvCUR not used any more) */
  2514.             }
  2515.             else if (curop->op_type == OP_RV2CV)
  2516.             break;
  2517.             else if (curop->op_type == OP_RV2SV ||
  2518.                  curop->op_type == OP_RV2AV ||
  2519.                  curop->op_type == OP_RV2HV ||
  2520.                  curop->op_type == OP_RV2GV) {
  2521.             if (lastop->op_type != OP_GV)    /* funny deref? */
  2522.                 break;
  2523.             }
  2524.             else if (curop->op_type == OP_PUSHRE) {
  2525.             if (((PMOP*)curop)->op_pmreplroot) {
  2526.                 GV *gv = (GV*)((PMOP*)curop)->op_pmreplroot;
  2527.                 if (gv == PL_defgv || SvCUR(gv) == PL_generation)
  2528.                 break;
  2529.                 SvCUR(gv) = PL_generation;
  2530.             }    
  2531.             }
  2532.             else
  2533.             break;
  2534.         }
  2535.         lastop = curop;
  2536.         }
  2537.         if (curop != o)
  2538.         o->op_private = OPpASSIGN_COMMON;
  2539.     }
  2540.     if (right && right->op_type == OP_SPLIT) {
  2541.         OP* tmpop;
  2542.         if ((tmpop = ((LISTOP*)right)->op_first) &&
  2543.         tmpop->op_type == OP_PUSHRE)
  2544.         {
  2545.         PMOP *pm = (PMOP*)tmpop;
  2546.         if (left->op_type == OP_RV2AV &&
  2547.             !(left->op_private & OPpLVAL_INTRO) &&
  2548.             !(o->op_private & OPpASSIGN_COMMON) )
  2549.         {
  2550.             tmpop = ((UNOP*)left)->op_first;
  2551.             if (tmpop->op_type == OP_GV && !pm->op_pmreplroot) {
  2552.             pm->op_pmreplroot = (OP*)((GVOP*)tmpop)->op_gv;
  2553.             pm->op_pmflags |= PMf_ONCE;
  2554.             tmpop = cUNOPo->op_first;    /* to list (nulled) */
  2555.             tmpop = ((UNOP*)tmpop)->op_first; /* to pushmark */
  2556.             tmpop->op_sibling = Nullop;    /* don't free split */
  2557.             right->op_next = tmpop->op_next;  /* fix starting loc */
  2558.             op_free(o);            /* blow off assign */
  2559.             right->op_flags &= ~OPf_WANT;
  2560.                 /* "I don't know and I don't care." */
  2561.             return right;
  2562.             }
  2563.         }
  2564.         else {
  2565.             if (PL_modcount < 10000 &&
  2566.               ((LISTOP*)right)->op_last->op_type == OP_CONST)
  2567.             {
  2568.             SV *sv = ((SVOP*)((LISTOP*)right)->op_last)->op_sv;
  2569.             if (SvIVX(sv) == 0)
  2570.                 sv_setiv(sv, PL_modcount+1);
  2571.             }
  2572.         }
  2573.         }
  2574.     }
  2575.     return o;
  2576.     }
  2577.     if (!right)
  2578.     right = newOP(OP_UNDEF, 0);
  2579.     if (right->op_type == OP_READLINE) {
  2580.     right->op_flags |= OPf_STACKED;
  2581.     return newBINOP(OP_NULL, flags, mod(scalar(left), OP_SASSIGN), scalar(right));
  2582.     }
  2583.     else {
  2584.     PL_eval_start = right;    /* Grandfathering $[ assignment here.  Bletch.*/
  2585.     o = newBINOP(OP_SASSIGN, flags,
  2586.         scalar(right), mod(scalar(left), OP_SASSIGN) );
  2587.     if (PL_eval_start)
  2588.         PL_eval_start = 0;
  2589.     else {
  2590.         op_free(o);
  2591.         return Nullop;
  2592.     }
  2593.     }
  2594.     return o;
  2595. }
  2596.  
  2597. OP *
  2598. newSTATEOP(I32 flags, char *label, OP *o)
  2599. {
  2600.     dTHR;
  2601.     U32 seq = intro_my();
  2602.     register COP *cop;
  2603.  
  2604.     Newz(1101, cop, 1, COP);
  2605.     if (PERLDB_LINE && PL_curcop->cop_line && PL_curstash != PL_debstash) {
  2606.     cop->op_type = OP_DBSTATE;
  2607.     cop->op_ppaddr = ppaddr[ OP_DBSTATE ];
  2608.     }
  2609.     else {
  2610.     cop->op_type = OP_NEXTSTATE;
  2611.     cop->op_ppaddr = ppaddr[ OP_NEXTSTATE ];
  2612.     }
  2613.     cop->op_flags = flags;
  2614.     cop->op_private = 0 | (flags >> 8);
  2615. #ifdef NATIVE_HINTS
  2616.     cop->op_private |= NATIVE_HINTS;
  2617. #endif
  2618.     cop->op_next = (OP*)cop;
  2619.  
  2620.     if (label) {
  2621.     cop->cop_label = label;
  2622.     PL_hints |= HINT_BLOCK_SCOPE;
  2623.     }
  2624.     cop->cop_seq = seq;
  2625.     cop->cop_arybase = PL_curcop->cop_arybase;
  2626.  
  2627.     if (PL_copline == NOLINE)
  2628.         cop->cop_line = PL_curcop->cop_line;
  2629.     else {
  2630.         cop->cop_line = PL_copline;
  2631.         PL_copline = NOLINE;
  2632.     }
  2633.     cop->cop_filegv = (GV*)SvREFCNT_inc(PL_curcop->cop_filegv);
  2634.     cop->cop_stash = PL_curstash;
  2635.  
  2636.     if (PERLDB_LINE && PL_curstash != PL_debstash) {
  2637.     SV **svp = av_fetch(GvAV(PL_curcop->cop_filegv),(I32)cop->cop_line, FALSE);
  2638.     if (svp && *svp != &PL_sv_undef && !SvIOK(*svp)) {
  2639.         (void)SvIOK_on(*svp);
  2640.         SvIVX(*svp) = 1;
  2641.         SvSTASH(*svp) = (HV*)cop;
  2642.     }
  2643.     }
  2644.  
  2645.     return prepend_elem(OP_LINESEQ, (OP*)cop, o);
  2646. }
  2647.  
  2648. /* "Introduce" my variables to visible status. */
  2649. U32
  2650. intro_my(void)
  2651. {
  2652.     SV **svp;
  2653.     SV *sv;
  2654.     I32 i;
  2655.  
  2656.     if (! PL_min_intro_pending)
  2657.     return PL_cop_seqmax;
  2658.  
  2659.     svp = AvARRAY(PL_comppad_name);
  2660.     for (i = PL_min_intro_pending; i <= PL_max_intro_pending; i++) {
  2661.     if ((sv = svp[i]) && sv != &PL_sv_undef && !SvIVX(sv)) {
  2662.         SvIVX(sv) = 999999999;    /* Don't know scope end yet. */
  2663.         SvNVX(sv) = (double)PL_cop_seqmax;
  2664.     }
  2665.     }
  2666.     PL_min_intro_pending = 0;
  2667.     PL_comppad_name_fill = PL_max_intro_pending;    /* Needn't search higher */
  2668.     return PL_cop_seqmax++;
  2669. }
  2670.  
  2671. OP *
  2672. newLOGOP(I32 type, I32 flags, OP *first, OP *other)
  2673. {
  2674.     return new_logop(type, flags, &first, &other);
  2675. }
  2676.  
  2677. STATIC OP *
  2678. new_logop(I32 type, I32 flags, OP** firstp, OP** otherp)
  2679. {
  2680.     dTHR;
  2681.     LOGOP *logop;
  2682.     OP *o;
  2683.     OP *first = *firstp;
  2684.     OP *other = *otherp;
  2685.  
  2686.     if (type == OP_XOR)        /* Not short circuit, but here by precedence. */
  2687.     return newBINOP(type, flags, scalar(first), scalar(other));
  2688.  
  2689.     scalarboolean(first);
  2690.     /* optimize "!a && b" to "a || b", and "!a || b" to "a && b" */
  2691.     if (first->op_type == OP_NOT && (first->op_flags & OPf_SPECIAL)) {
  2692.     if (type == OP_AND || type == OP_OR) {
  2693.         if (type == OP_AND)
  2694.         type = OP_OR;
  2695.         else
  2696.         type = OP_AND;
  2697.         o = first;
  2698.         first = *firstp = cUNOPo->op_first;
  2699.         if (o->op_next)
  2700.         first->op_next = o->op_next;
  2701.         cUNOPo->op_first = Nullop;
  2702.         op_free(o);
  2703.     }
  2704.     }
  2705.     if (first->op_type == OP_CONST) {
  2706.     if (PL_dowarn && (first->op_private & OPpCONST_BARE))
  2707.         warn("Probable precedence problem on %s", op_desc[type]);
  2708.     if ((type == OP_AND) == (SvTRUE(((SVOP*)first)->op_sv))) {
  2709.         op_free(first);
  2710.         *firstp = Nullop;
  2711.         return other;
  2712.     }
  2713.     else {
  2714.         op_free(other);
  2715.         *otherp = Nullop;
  2716.         return first;
  2717.     }
  2718.     }
  2719.     else if (first->op_type == OP_WANTARRAY) {
  2720.     if (type == OP_AND)
  2721.         list(other);
  2722.     else
  2723.         scalar(other);
  2724.     }
  2725.     else if (PL_dowarn && (first->op_flags & OPf_KIDS)) {
  2726.     OP *k1 = ((UNOP*)first)->op_first;
  2727.     OP *k2 = k1->op_sibling;
  2728.     OPCODE warnop = 0;
  2729.     switch (first->op_type)
  2730.     {
  2731.     case OP_NULL:
  2732.         if (k2 && k2->op_type == OP_READLINE
  2733.           && (k2->op_flags & OPf_STACKED)
  2734.           && ((k1->op_flags & OPf_WANT) == OPf_WANT_SCALAR)) 
  2735.         warnop = k2->op_type;
  2736.         break;
  2737.  
  2738.     case OP_SASSIGN:
  2739.         if (k1->op_type == OP_READDIR
  2740.           || k1->op_type == OP_GLOB
  2741.           || k1->op_type == OP_EACH)
  2742.         warnop = k1->op_type;
  2743.         break;
  2744.     }
  2745.     if (warnop) {
  2746.         line_t oldline = PL_curcop->cop_line;
  2747.         PL_curcop->cop_line = PL_copline;
  2748.         warn("Value of %s%s can be \"0\"; test with defined()",
  2749.          op_desc[warnop],
  2750.          ((warnop == OP_READLINE || warnop == OP_GLOB)
  2751.           ? " construct" : "() operator"));
  2752.         PL_curcop->cop_line = oldline;
  2753.     }
  2754.     }
  2755.  
  2756.     if (!other)
  2757.     return first;
  2758.  
  2759.     if (type == OP_ANDASSIGN || type == OP_ORASSIGN)
  2760.     other->op_private |= OPpASSIGN_BACKWARDS;  /* other is an OP_SASSIGN */
  2761.  
  2762.     Newz(1101, logop, 1, LOGOP);
  2763.  
  2764.     logop->op_type = type;
  2765.     logop->op_ppaddr = ppaddr[type];
  2766.     logop->op_first = first;
  2767.     logop->op_flags = flags | OPf_KIDS;
  2768.     logop->op_other = LINKLIST(other);
  2769.     logop->op_private = 1 | (flags >> 8);
  2770.  
  2771.     /* establish postfix order */
  2772.     logop->op_next = LINKLIST(first);
  2773.     first->op_next = (OP*)logop;
  2774.     first->op_sibling = other;
  2775.  
  2776.     o = newUNOP(OP_NULL, 0, (OP*)logop);
  2777.     other->op_next = o;
  2778.  
  2779.     return o;
  2780. }
  2781.  
  2782. OP *
  2783. newCONDOP(I32 flags, OP *first, OP *trueop, OP *falseop)
  2784. {
  2785.     dTHR;
  2786.     CONDOP *condop;
  2787.     OP *o;
  2788.  
  2789.     if (!falseop)
  2790.     return newLOGOP(OP_AND, 0, first, trueop);
  2791.     if (!trueop)
  2792.     return newLOGOP(OP_OR, 0, first, falseop);
  2793.  
  2794.     scalarboolean(first);
  2795.     if (first->op_type == OP_CONST) {
  2796.     if (SvTRUE(((SVOP*)first)->op_sv)) {
  2797.         op_free(first);
  2798.         op_free(falseop);
  2799.         return trueop;
  2800.     }
  2801.     else {
  2802.         op_free(first);
  2803.         op_free(trueop);
  2804.         return falseop;
  2805.     }
  2806.     }
  2807.     else if (first->op_type == OP_WANTARRAY) {
  2808.     list(trueop);
  2809.     scalar(falseop);
  2810.     }
  2811.     Newz(1101, condop, 1, CONDOP);
  2812.  
  2813.     condop->op_type = OP_COND_EXPR;
  2814.     condop->op_ppaddr = ppaddr[OP_COND_EXPR];
  2815.     condop->op_first = first;
  2816.     condop->op_flags = flags | OPf_KIDS;
  2817.     condop->op_true = LINKLIST(trueop);
  2818.     condop->op_false = LINKLIST(falseop);
  2819.     condop->op_private = 1 | (flags >> 8);
  2820.  
  2821.     /* establish postfix order */
  2822.     condop->op_next = LINKLIST(first);
  2823.     first->op_next = (OP*)condop;
  2824.  
  2825.     first->op_sibling = trueop;
  2826.     trueop->op_sibling = falseop;
  2827.     o = newUNOP(OP_NULL, 0, (OP*)condop);
  2828.  
  2829.     trueop->op_next = o;
  2830.     falseop->op_next = o;
  2831.  
  2832.     return o;
  2833. }
  2834.  
  2835. OP *
  2836. newRANGE(I32 flags, OP *left, OP *right)
  2837. {
  2838.     dTHR;
  2839.     CONDOP *condop;
  2840.     OP *flip;
  2841.     OP *flop;
  2842.     OP *o;
  2843.  
  2844.     Newz(1101, condop, 1, CONDOP);
  2845.  
  2846.     condop->op_type = OP_RANGE;
  2847.     condop->op_ppaddr = ppaddr[OP_RANGE];
  2848.     condop->op_first = left;
  2849.     condop->op_flags = OPf_KIDS;
  2850.     condop->op_true = LINKLIST(left);
  2851.     condop->op_false = LINKLIST(right);
  2852.     condop->op_private = 1 | (flags >> 8);
  2853.  
  2854.     left->op_sibling = right;
  2855.  
  2856.     condop->op_next = (OP*)condop;
  2857.     flip = newUNOP(OP_FLIP, flags, (OP*)condop);
  2858.     flop = newUNOP(OP_FLOP, 0, flip);
  2859.     o = newUNOP(OP_NULL, 0, flop);
  2860.     linklist(flop);
  2861.  
  2862.     left->op_next = flip;
  2863.     right->op_next = flop;
  2864.  
  2865.     condop->op_targ = pad_alloc(OP_RANGE, SVs_PADMY);
  2866.     sv_upgrade(PAD_SV(condop->op_targ), SVt_PVNV);
  2867.     flip->op_targ = pad_alloc(OP_RANGE, SVs_PADMY);
  2868.     sv_upgrade(PAD_SV(flip->op_targ), SVt_PVNV);
  2869.  
  2870.     flip->op_private =  left->op_type == OP_CONST ? OPpFLIP_LINENUM : 0;
  2871.     flop->op_private = right->op_type == OP_CONST ? OPpFLIP_LINENUM : 0;
  2872.  
  2873.     flip->op_next = o;
  2874.     if (!flip->op_private || !flop->op_private)
  2875.     linklist(o);        /* blow off optimizer unless constant */
  2876.  
  2877.     return o;
  2878. }
  2879.  
  2880. OP *
  2881. newLOOPOP(I32 flags, I32 debuggable, OP *expr, OP *block)
  2882. {
  2883.     dTHR;
  2884.     OP* listop;
  2885.     OP* o;
  2886.     int once = block && block->op_flags & OPf_SPECIAL &&
  2887.       (block->op_type == OP_ENTERSUB || block->op_type == OP_NULL);
  2888.  
  2889.     if (expr) {
  2890.     if (once && expr->op_type == OP_CONST && !SvTRUE(((SVOP*)expr)->op_sv))
  2891.         return block;    /* do {} while 0 does once */
  2892.     if (expr->op_type == OP_READLINE || expr->op_type == OP_GLOB
  2893.         || (expr->op_type == OP_NULL && expr->op_targ == OP_GLOB)) {
  2894.         expr = newUNOP(OP_DEFINED, 0,
  2895.         newASSIGNOP(0, newDEFSVOP(), 0, expr) );
  2896.     } else if (expr->op_flags & OPf_KIDS) {
  2897.         OP *k1 = ((UNOP*)expr)->op_first;
  2898.         OP *k2 = (k1) ? k1->op_sibling : NULL;
  2899.         switch (expr->op_type) {
  2900.           case OP_NULL: 
  2901.         if (k2 && k2->op_type == OP_READLINE
  2902.               && (k2->op_flags & OPf_STACKED)
  2903.               && ((k1->op_flags & OPf_WANT) == OPf_WANT_SCALAR)) 
  2904.             expr = newUNOP(OP_DEFINED, 0, expr);
  2905.         break;                                
  2906.  
  2907.           case OP_SASSIGN:
  2908.         if (k1->op_type == OP_READDIR
  2909.               || k1->op_type == OP_GLOB
  2910.               || k1->op_type == OP_EACH)
  2911.             expr = newUNOP(OP_DEFINED, 0, expr);
  2912.         break;
  2913.         }
  2914.     }
  2915.     }
  2916.  
  2917.     listop = append_elem(OP_LINESEQ, block, newOP(OP_UNSTACK, 0));
  2918.     o = new_logop(OP_AND, 0, &expr, &listop);
  2919.  
  2920.     if (listop)
  2921.     ((LISTOP*)listop)->op_last->op_next = LINKLIST(o);
  2922.  
  2923.     if (once && o != listop)
  2924.     o->op_next = ((LOGOP*)cUNOPo->op_first)->op_other;
  2925.  
  2926.     if (o == listop)
  2927.     o = newUNOP(OP_NULL, 0, o);    /* or do {} while 1 loses outer block */
  2928.  
  2929.     o->op_flags |= flags;
  2930.     o = scope(o);
  2931.     o->op_flags |= OPf_SPECIAL;    /* suppress POPBLOCK curpm restoration*/
  2932.     return o;
  2933. }
  2934.  
  2935. OP *
  2936. newWHILEOP(I32 flags, I32 debuggable, LOOP *loop, I32 whileline, OP *expr, OP *block, OP *cont)
  2937. {
  2938.     dTHR;
  2939.     OP *redo;
  2940.     OP *next = 0;
  2941.     OP *listop;
  2942.     OP *o;
  2943.     OP *condop;
  2944.  
  2945.     if (expr && (expr->op_type == OP_READLINE || expr->op_type == OP_GLOB
  2946.          || (expr->op_type == OP_NULL && expr->op_targ == OP_GLOB))) {
  2947.     expr = newUNOP(OP_DEFINED, 0,
  2948.         newASSIGNOP(0, newDEFSVOP(), 0, expr) );
  2949.     } else if (expr && (expr->op_flags & OPf_KIDS)) {
  2950.     OP *k1 = ((UNOP*)expr)->op_first;
  2951.     OP *k2 = (k1) ? k1->op_sibling : NULL;
  2952.     switch (expr->op_type) {
  2953.       case OP_NULL: 
  2954.         if (k2 && k2->op_type == OP_READLINE
  2955.           && (k2->op_flags & OPf_STACKED)
  2956.           && ((k1->op_flags & OPf_WANT) == OPf_WANT_SCALAR)) 
  2957.         expr = newUNOP(OP_DEFINED, 0, expr);
  2958.         break;                                
  2959.  
  2960.       case OP_SASSIGN:
  2961.         if (k1->op_type == OP_READDIR
  2962.           || k1->op_type == OP_GLOB
  2963.           || k1->op_type == OP_EACH)
  2964.         expr = newUNOP(OP_DEFINED, 0, expr);
  2965.         break;
  2966.     }
  2967.     }
  2968.  
  2969.     if (!block)
  2970.     block = newOP(OP_NULL, 0);
  2971.  
  2972.     if (cont)
  2973.     next = LINKLIST(cont);
  2974.     if (expr) {
  2975.     cont = append_elem(OP_LINESEQ, cont, newOP(OP_UNSTACK, 0));
  2976.     if ((line_t)whileline != NOLINE) {
  2977.         PL_copline = whileline;
  2978.         cont = append_elem(OP_LINESEQ, cont,
  2979.                    newSTATEOP(0, Nullch, Nullop));
  2980.     }
  2981.     }
  2982.  
  2983.     listop = append_list(OP_LINESEQ, (LISTOP*)block, (LISTOP*)cont);
  2984.     redo = LINKLIST(listop);
  2985.  
  2986.     if (expr) {
  2987.     PL_copline = whileline;
  2988.     scalar(listop);
  2989.     o = new_logop(OP_AND, 0, &expr, &listop);
  2990.     if (o == expr && o->op_type == OP_CONST && !SvTRUE(cSVOPo->op_sv)) {
  2991.         op_free(expr);        /* oops, it's a while (0) */
  2992.         op_free((OP*)loop);
  2993.         return Nullop;        /* listop already freed by new_logop */
  2994.     }
  2995.     if (listop)
  2996.         ((LISTOP*)listop)->op_last->op_next = condop =
  2997.         (o == listop ? redo : LINKLIST(o));
  2998.     if (!next)
  2999.         next = condop;
  3000.     }
  3001.     else
  3002.     o = listop;
  3003.  
  3004.     if (!loop) {
  3005.     Newz(1101,loop,1,LOOP);
  3006.     loop->op_type = OP_ENTERLOOP;
  3007.     loop->op_ppaddr = ppaddr[OP_ENTERLOOP];
  3008.     loop->op_private = 0;
  3009.     loop->op_next = (OP*)loop;
  3010.     }
  3011.  
  3012.     o = newBINOP(OP_LEAVELOOP, 0, (OP*)loop, o);
  3013.  
  3014.     loop->op_redoop = redo;
  3015.     loop->op_lastop = o;
  3016.  
  3017.     if (next)
  3018.     loop->op_nextop = next;
  3019.     else
  3020.     loop->op_nextop = o;
  3021.  
  3022.     o->op_flags |= flags;
  3023.     o->op_private |= (flags >> 8);
  3024.     return o;
  3025. }
  3026.  
  3027. OP *
  3028. newFOROP(I32 flags,char *label,line_t forline,OP *sv,OP *expr,OP *block,OP *cont)
  3029. {
  3030.     LOOP *loop;
  3031.     OP *wop;
  3032.     int padoff = 0;
  3033.     I32 iterflags = 0;
  3034.  
  3035.     if (sv) {
  3036.     if (sv->op_type == OP_RV2SV) {    /* symbol table variable */
  3037.         sv->op_type = OP_RV2GV;
  3038.         sv->op_ppaddr = ppaddr[OP_RV2GV];
  3039.     }
  3040.     else if (sv->op_type == OP_PADSV) { /* private variable */
  3041.         padoff = sv->op_targ;
  3042.         op_free(sv);
  3043.         sv = Nullop;
  3044.     }
  3045.     else if (sv->op_type == OP_THREADSV) { /* per-thread variable */
  3046.         padoff = sv->op_targ;
  3047.         iterflags |= OPf_SPECIAL;
  3048.         op_free(sv);
  3049.         sv = Nullop;
  3050.     }
  3051.     else
  3052.         croak("Can't use %s for loop variable", op_desc[sv->op_type]);
  3053.     }
  3054.     else {
  3055. #ifdef USE_THREADS
  3056.     padoff = find_threadsv("_");
  3057.     iterflags |= OPf_SPECIAL;
  3058. #else
  3059.     sv = newGVOP(OP_GV, 0, PL_defgv);
  3060. #endif
  3061.     }
  3062.     if (expr->op_type == OP_RV2AV || expr->op_type == OP_PADAV) {
  3063.     expr = mod(force_list(scalar(ref(expr, OP_ITER))), OP_GREPSTART);
  3064.     iterflags |= OPf_STACKED;
  3065.     }
  3066.     else if (expr->op_type == OP_NULL &&
  3067.              (expr->op_flags & OPf_KIDS) &&
  3068.              ((BINOP*)expr)->op_first->op_type == OP_FLOP)
  3069.     {
  3070.     /* Basically turn for($x..$y) into the same as for($x,$y), but we
  3071.      * set the STACKED flag to indicate that these values are to be
  3072.      * treated as min/max values by 'pp_iterinit'.
  3073.      */
  3074.     UNOP* flip = (UNOP*)((UNOP*)((BINOP*)expr)->op_first)->op_first;
  3075.     CONDOP* range = (CONDOP*) flip->op_first;
  3076.     OP* left  = range->op_first;
  3077.     OP* right = left->op_sibling;
  3078.     LISTOP* listop;
  3079.  
  3080.     range->op_flags &= ~OPf_KIDS;
  3081.     range->op_first = Nullop;
  3082.  
  3083.     listop = (LISTOP*)newLISTOP(OP_LIST, 0, left, right);
  3084.     listop->op_first->op_next = range->op_true;
  3085.     left->op_next = range->op_false;
  3086.     right->op_next = (OP*)listop;
  3087.     listop->op_next = listop->op_first;
  3088.  
  3089.     op_free(expr);
  3090.     expr = (OP*)(listop);
  3091.         null(expr);
  3092.     iterflags |= OPf_STACKED;
  3093.     }
  3094.     else {
  3095.         expr = mod(force_list(expr), OP_GREPSTART);
  3096.     }
  3097.  
  3098.  
  3099.     loop = (LOOP*)list(convert(OP_ENTERITER, iterflags,
  3100.                    append_elem(OP_LIST, expr, scalar(sv))));
  3101.     assert(!loop->op_next);
  3102.     Renew(loop, 1, LOOP);
  3103.     loop->op_targ = padoff;
  3104.     wop = newWHILEOP(flags, 1, loop, forline, newOP(OP_ITER, 0), block, cont);
  3105.     PL_copline = forline;
  3106.     return newSTATEOP(0, label, wop);
  3107. }
  3108.  
  3109. OP*
  3110. newLOOPEX(I32 type, OP *label)
  3111. {
  3112.     dTHR;
  3113.     OP *o;
  3114.     if (type != OP_GOTO || label->op_type == OP_CONST) {
  3115.     /* "last()" means "last" */
  3116.     if (label->op_type == OP_STUB && (label->op_flags & OPf_PARENS))
  3117.         o = newOP(type, OPf_SPECIAL);
  3118.     else {
  3119.         o = newPVOP(type, 0, savepv(label->op_type == OP_CONST
  3120.                     ? SvPVx(((SVOP*)label)->op_sv, PL_na)
  3121.                     : ""));
  3122.     }
  3123.     op_free(label);
  3124.     }
  3125.     else {
  3126.     if (label->op_type == OP_ENTERSUB)
  3127.         label = newUNOP(OP_REFGEN, 0, mod(label, OP_REFGEN));
  3128.     o = newUNOP(type, OPf_STACKED, label);
  3129.     }
  3130.     PL_hints |= HINT_BLOCK_SCOPE;
  3131.     return o;
  3132. }
  3133.  
  3134. void
  3135. cv_undef(CV *cv)
  3136. {
  3137.     dTHR;
  3138. #ifdef USE_THREADS
  3139.     if (CvMUTEXP(cv)) {
  3140.     MUTEX_DESTROY(CvMUTEXP(cv));
  3141.     Safefree(CvMUTEXP(cv));
  3142.     CvMUTEXP(cv) = 0;
  3143.     }
  3144. #endif /* USE_THREADS */
  3145.  
  3146.     if (!CvXSUB(cv) && CvROOT(cv)) {
  3147. #ifdef USE_THREADS
  3148.     if (CvDEPTH(cv) || (CvOWNER(cv) && CvOWNER(cv) != thr))
  3149.         croak("Can't undef active subroutine");
  3150. #else
  3151.     if (CvDEPTH(cv))
  3152.         croak("Can't undef active subroutine");
  3153. #endif /* USE_THREADS */
  3154.     ENTER;
  3155.  
  3156.     SAVESPTR(PL_curpad);
  3157.     PL_curpad = 0;
  3158.  
  3159.     if (!CvCLONED(cv))
  3160.         op_free(CvROOT(cv));
  3161.     CvROOT(cv) = Nullop;
  3162.     LEAVE;
  3163.     }
  3164.     SvPOK_off((SV*)cv);        /* forget prototype */
  3165.     CvFLAGS(cv) = 0;
  3166.     SvREFCNT_dec(CvGV(cv));
  3167.     CvGV(cv) = Nullgv;
  3168.     SvREFCNT_dec(CvOUTSIDE(cv));
  3169.     CvOUTSIDE(cv) = Nullcv;
  3170.     if (CvPADLIST(cv)) {
  3171.     /* may be during global destruction */
  3172.     if (SvREFCNT(CvPADLIST(cv))) {
  3173.         I32 i = AvFILLp(CvPADLIST(cv));
  3174.         while (i >= 0) {
  3175.         SV** svp = av_fetch(CvPADLIST(cv), i--, FALSE);
  3176.         SV* sv = svp ? *svp : Nullsv;
  3177.         if (!sv)
  3178.             continue;
  3179.         if (sv == (SV*)PL_comppad_name)
  3180.             PL_comppad_name = Nullav;
  3181.         else if (sv == (SV*)PL_comppad) {
  3182.             PL_comppad = Nullav;
  3183.             PL_curpad = Null(SV**);
  3184.         }
  3185.         SvREFCNT_dec(sv);
  3186.         }
  3187.         SvREFCNT_dec((SV*)CvPADLIST(cv));
  3188.     }
  3189.     CvPADLIST(cv) = Nullav;
  3190.     }
  3191. }
  3192.  
  3193. #ifdef DEBUG_CLOSURES
  3194. STATIC void
  3195. cv_dump(cv)
  3196. CV* cv;
  3197. {
  3198.     CV *outside = CvOUTSIDE(cv);
  3199.     AV* padlist = CvPADLIST(cv);
  3200.     AV* pad_name;
  3201.     AV* pad;
  3202.     SV** pname;
  3203.     SV** ppad;
  3204.     I32 ix;
  3205.  
  3206.     PerlIO_printf(Perl_debug_log, "\tCV=0x%lx (%s), OUTSIDE=0x%lx (%s)\n",
  3207.           cv,
  3208.           (CvANON(cv) ? "ANON"
  3209.            : (cv == PL_main_cv) ? "MAIN"
  3210.            : CvUNIQUE(outside) ? "UNIQUE"
  3211.            : CvGV(cv) ? GvNAME(CvGV(cv)) : "UNDEFINED"),
  3212.           outside,
  3213.           (!outside ? "null"
  3214.            : CvANON(outside) ? "ANON"
  3215.            : (outside == PL_main_cv) ? "MAIN"
  3216.            : CvUNIQUE(outside) ? "UNIQUE"
  3217.            : CvGV(outside) ? GvNAME(CvGV(outside)) : "UNDEFINED"));
  3218.  
  3219.     if (!padlist)
  3220.     return;
  3221.  
  3222.     pad_name = (AV*)*av_fetch(padlist, 0, FALSE);
  3223.     pad = (AV*)*av_fetch(padlist, 1, FALSE);
  3224.     pname = AvARRAY(pad_name);
  3225.     ppad = AvARRAY(pad);
  3226.  
  3227.     for (ix = 1; ix <= AvFILLp(pad_name); ix++) {
  3228.     if (SvPOK(pname[ix]))
  3229.         PerlIO_printf(Perl_debug_log, "\t%4d. 0x%lx (%s\"%s\" %ld-%ld)\n",
  3230.               ix, ppad[ix],
  3231.               SvFAKE(pname[ix]) ? "FAKE " : "",
  3232.               SvPVX(pname[ix]),
  3233.               (long)I_32(SvNVX(pname[ix])),
  3234.               (long)SvIVX(pname[ix]));
  3235.     }
  3236. }
  3237. #endif /* DEBUG_CLOSURES */
  3238.  
  3239. STATIC CV *
  3240. cv_clone2(CV *proto, CV *outside)
  3241. {
  3242.     dTHR;
  3243.     AV* av;
  3244.     I32 ix;
  3245.     AV* protopadlist = CvPADLIST(proto);
  3246.     AV* protopad_name = (AV*)*av_fetch(protopadlist, 0, FALSE);
  3247.     AV* protopad = (AV*)*av_fetch(protopadlist, 1, FALSE);
  3248.     SV** pname = AvARRAY(protopad_name);
  3249.     SV** ppad = AvARRAY(protopad);
  3250.     I32 fname = AvFILLp(protopad_name);
  3251.     I32 fpad = AvFILLp(protopad);
  3252.     AV* comppadlist;
  3253.     CV* cv;
  3254.  
  3255.     assert(!CvUNIQUE(proto));
  3256.  
  3257.     ENTER;
  3258.     SAVESPTR(PL_curpad);
  3259.     SAVESPTR(PL_comppad);
  3260.     SAVESPTR(PL_comppad_name);
  3261.     SAVESPTR(PL_compcv);
  3262.  
  3263.     cv = PL_compcv = (CV*)NEWSV(1104,0);
  3264.     sv_upgrade((SV *)cv, SvTYPE(proto));
  3265.     CvCLONED_on(cv);
  3266.     if (CvANON(proto))
  3267.     CvANON_on(cv);
  3268.  
  3269. #ifdef USE_THREADS
  3270.     New(666, CvMUTEXP(cv), 1, perl_mutex);
  3271.     MUTEX_INIT(CvMUTEXP(cv));
  3272.     CvOWNER(cv)        = 0;
  3273. #endif /* USE_THREADS */
  3274.     CvFILEGV(cv)    = CvFILEGV(proto);
  3275.     CvGV(cv)        = (GV*)SvREFCNT_inc(CvGV(proto));
  3276.     CvSTASH(cv)        = CvSTASH(proto);
  3277.     CvROOT(cv)        = CvROOT(proto);
  3278.     CvSTART(cv)        = CvSTART(proto);
  3279.     if (outside)
  3280.     CvOUTSIDE(cv)    = (CV*)SvREFCNT_inc(outside);
  3281.  
  3282.     if (SvPOK(proto))
  3283.     sv_setpvn((SV*)cv, SvPVX(proto), SvCUR(proto));
  3284.  
  3285.     PL_comppad_name = newAV();
  3286.     for (ix = fname; ix >= 0; ix--)
  3287.     av_store(PL_comppad_name, ix, SvREFCNT_inc(pname[ix]));
  3288.  
  3289.     PL_comppad = newAV();
  3290.  
  3291.     comppadlist = newAV();
  3292.     AvREAL_off(comppadlist);
  3293.     av_store(comppadlist, 0, (SV*)PL_comppad_name);
  3294.     av_store(comppadlist, 1, (SV*)PL_comppad);
  3295.     CvPADLIST(cv) = comppadlist;
  3296.     av_fill(PL_comppad, AvFILLp(protopad));
  3297.     PL_curpad = AvARRAY(PL_comppad);
  3298.  
  3299.     av = newAV();           /* will be @_ */
  3300.     av_extend(av, 0);
  3301.     av_store(PL_comppad, 0, (SV*)av);
  3302.     AvFLAGS(av) = AVf_REIFY;
  3303.  
  3304.     for (ix = fpad; ix > 0; ix--) {
  3305.     SV* namesv = (ix <= fname) ? pname[ix] : Nullsv;
  3306.     if (namesv && namesv != &PL_sv_undef) {
  3307.         char *name = SvPVX(namesv);    /* XXX */
  3308.         if (SvFLAGS(namesv) & SVf_FAKE) {   /* lexical from outside? */
  3309.         I32 off = pad_findlex(name, ix, SvIVX(namesv),
  3310.                       CvOUTSIDE(cv), cxstack_ix);
  3311.         if (!off)
  3312.             PL_curpad[ix] = SvREFCNT_inc(ppad[ix]);
  3313.         else if (off != ix)
  3314.             croak("panic: cv_clone: %s", name);
  3315.         }
  3316.         else {                /* our own lexical */
  3317.         SV* sv;
  3318.         if (*name == '&') {
  3319.             /* anon code -- we'll come back for it */
  3320.             sv = SvREFCNT_inc(ppad[ix]);
  3321.         }
  3322.         else if (*name == '@')
  3323.             sv = (SV*)newAV();
  3324.         else if (*name == '%')
  3325.             sv = (SV*)newHV();
  3326.         else
  3327.             sv = NEWSV(0,0);
  3328.         if (!SvPADBUSY(sv))
  3329.             SvPADMY_on(sv);
  3330.         PL_curpad[ix] = sv;
  3331.         }
  3332.     }
  3333.     else {
  3334.         SV* sv = NEWSV(0,0);
  3335.         SvPADTMP_on(sv);
  3336.         PL_curpad[ix] = sv;
  3337.     }
  3338.     }
  3339.  
  3340.     /* Now that vars are all in place, clone nested closures. */
  3341.  
  3342.     for (ix = fpad; ix > 0; ix--) {
  3343.     SV* namesv = (ix <= fname) ? pname[ix] : Nullsv;
  3344.     if (namesv
  3345.         && namesv != &PL_sv_undef
  3346.         && !(SvFLAGS(namesv) & SVf_FAKE)
  3347.         && *SvPVX(namesv) == '&'
  3348.         && CvCLONE(ppad[ix]))
  3349.     {
  3350.         CV *kid = cv_clone2((CV*)ppad[ix], cv);
  3351.         SvREFCNT_dec(ppad[ix]);
  3352.         CvCLONE_on(kid);
  3353.         SvPADMY_on(kid);
  3354.         PL_curpad[ix] = (SV*)kid;
  3355.     }
  3356.     }
  3357.  
  3358. #ifdef DEBUG_CLOSURES
  3359.     PerlIO_printf(Perl_debug_log, "Cloned inside:\n");
  3360.     cv_dump(outside);
  3361.     PerlIO_printf(Perl_debug_log, "  from:\n");
  3362.     cv_dump(proto);
  3363.     PerlIO_printf(Perl_debug_log, "   to:\n");
  3364.     cv_dump(cv);
  3365. #endif
  3366.  
  3367.     LEAVE;
  3368.     return cv;
  3369. }
  3370.  
  3371. CV *
  3372. cv_clone(CV *proto)
  3373. {
  3374.     return cv_clone2(proto, CvOUTSIDE(proto));
  3375. }
  3376.  
  3377. void
  3378. cv_ckproto(CV *cv, GV *gv, char *p)
  3379. {
  3380.     if ((!p != !SvPOK(cv)) || (p && strNE(p, SvPVX(cv)))) {
  3381.     SV* msg = sv_newmortal();
  3382.     SV* name = Nullsv;
  3383.  
  3384.     if (gv)
  3385.         gv_efullname3(name = sv_newmortal(), gv, Nullch);
  3386.     sv_setpv(msg, "Prototype mismatch:");
  3387.     if (name)
  3388.         sv_catpvf(msg, " sub %_", name);
  3389.     if (SvPOK(cv))
  3390.         sv_catpvf(msg, " (%s)", SvPVX(cv));
  3391.     sv_catpv(msg, " vs ");
  3392.     if (p)
  3393.         sv_catpvf(msg, "(%s)", p);
  3394.     else
  3395.         sv_catpv(msg, "none");
  3396.     warn("%_", msg);
  3397.     }
  3398. }
  3399.  
  3400. SV *
  3401. cv_const_sv(CV *cv)
  3402. {
  3403.     if (!cv || !SvPOK(cv) || SvCUR(cv))
  3404.     return Nullsv;
  3405.     return op_const_sv(CvSTART(cv), cv);
  3406. }
  3407.  
  3408. SV *
  3409. op_const_sv(OP *o, CV *cv)
  3410. {
  3411.     SV *sv = Nullsv;
  3412.  
  3413.     if(!o)
  3414.     return Nullsv;
  3415.  
  3416.     if(o->op_type == OP_LINESEQ && cLISTOPo->op_first) 
  3417.     o = cLISTOPo->op_first->op_sibling;
  3418.  
  3419.     for (; o; o = o->op_next) {
  3420.     OPCODE type = o->op_type;
  3421.  
  3422.     if(sv && o->op_next == o) 
  3423.         return sv;
  3424.     if (type == OP_NEXTSTATE || type == OP_NULL || type == OP_PUSHMARK)
  3425.         continue;
  3426.     if (type == OP_LEAVESUB || type == OP_RETURN)
  3427.         break;
  3428.     if (sv)
  3429.         return Nullsv;
  3430.     if (type == OP_CONST)
  3431.         sv = cSVOPo->op_sv;
  3432.     else if (type == OP_PADSV && cv) {
  3433.         AV* padav = (AV*)(AvARRAY(CvPADLIST(cv))[1]);
  3434.         sv = padav ? AvARRAY(padav)[o->op_targ] : Nullsv;
  3435.         if (!sv || (!SvREADONLY(sv) && SvREFCNT(sv) > 1))
  3436.         return Nullsv;
  3437.     }
  3438.     else
  3439.         return Nullsv;
  3440.     }
  3441.     if (sv)
  3442.     SvREADONLY_on(sv);
  3443.     return sv;
  3444. }
  3445.  
  3446. CV *
  3447. newSUB(I32 floor, OP *o, OP *proto, OP *block)
  3448. {
  3449.     dTHR;
  3450.     char *name = o ? SvPVx(cSVOPo->op_sv, PL_na) : Nullch;
  3451.     GV *gv = gv_fetchpv(name ? name : "__ANON__",
  3452.             GV_ADDMULTI | (block ? 0 : GV_NOINIT), SVt_PVCV);
  3453.     char *ps = proto ? SvPVx(((SVOP*)proto)->op_sv, PL_na) : Nullch;
  3454.     register CV *cv=0;
  3455.     I32 ix;
  3456.  
  3457.     if (o)
  3458.     SAVEFREEOP(o);
  3459.     if (proto)
  3460.     SAVEFREEOP(proto);
  3461.  
  3462.     if (SvTYPE(gv) != SVt_PVGV) {    /* Prototype now, and had
  3463.                        maximum a prototype before. */
  3464.     if (SvTYPE(gv) > SVt_NULL) {
  3465.         if (!SvPOK((SV*)gv) && !(SvIOK((SV*)gv) && SvIVX((SV*)gv) == -1))
  3466.         warn("Runaway prototype");
  3467.         cv_ckproto((CV*)gv, NULL, ps);
  3468.     }
  3469.     if (ps)
  3470.         sv_setpv((SV*)gv, ps);
  3471.     else
  3472.         sv_setiv((SV*)gv, -1);
  3473.     SvREFCNT_dec(PL_compcv);
  3474.     cv = PL_compcv = NULL;
  3475.     PL_sub_generation++;
  3476.     goto noblock;
  3477.     }
  3478.  
  3479.     if (!name || GvCVGEN(gv))
  3480.     cv = Nullcv;
  3481.     else if (cv = GvCV(gv)) {
  3482.     cv_ckproto(cv, gv, ps);
  3483.     /* already defined (or promised)? */
  3484.     if (CvROOT(cv) || CvXSUB(cv) || GvASSUMECV(gv)) {
  3485.         SV* const_sv;
  3486.         bool const_changed = TRUE;
  3487.         if (!block) {
  3488.         /* just a "sub foo;" when &foo is already defined */
  3489.         SAVEFREESV(PL_compcv);
  3490.         goto done;
  3491.         }
  3492.         /* ahem, death to those who redefine active sort subs */
  3493.         if (PL_curstackinfo->si_type == PERLSI_SORT && PL_sortcop == CvSTART(cv))
  3494.         croak("Can't redefine active sort subroutine %s", name);
  3495.         if(const_sv = cv_const_sv(cv))
  3496.         const_changed = sv_cmp(const_sv, op_const_sv(block, Nullcv));
  3497.         if ((const_sv && const_changed) || PL_dowarn && !(CvGV(cv) && GvSTASH(CvGV(cv))
  3498.                     && HvNAME(GvSTASH(CvGV(cv)))
  3499.                     && strEQ(HvNAME(GvSTASH(CvGV(cv))),
  3500.                          "autouse"))) {
  3501.         line_t oldline = PL_curcop->cop_line;
  3502.         PL_curcop->cop_line = PL_copline;
  3503.         warn(const_sv ? "Constant subroutine %s redefined"
  3504.              : "Subroutine %s redefined", name);
  3505.         PL_curcop->cop_line = oldline;
  3506.         }
  3507.         SvREFCNT_dec(cv);
  3508.         cv = Nullcv;
  3509.     }
  3510.     }
  3511.     if (cv) {                /* must reuse cv if autoloaded */
  3512.     cv_undef(cv);
  3513.     CvFLAGS(cv) = CvFLAGS(PL_compcv);
  3514.     CvOUTSIDE(cv) = CvOUTSIDE(PL_compcv);
  3515.     CvOUTSIDE(PL_compcv) = 0;
  3516.     CvPADLIST(cv) = CvPADLIST(PL_compcv);
  3517.     CvPADLIST(PL_compcv) = 0;
  3518.     if (SvREFCNT(PL_compcv) > 1) /* XXX Make closures transit through stub. */
  3519.         CvOUTSIDE(PL_compcv) = (CV*)SvREFCNT_inc((SV*)cv);
  3520.     SvREFCNT_dec(PL_compcv);
  3521.     }
  3522.     else {
  3523.     cv = PL_compcv;
  3524.     if (name) {
  3525.         GvCV(gv) = cv;
  3526.         GvCVGEN(gv) = 0;
  3527.         PL_sub_generation++;
  3528.     }
  3529.     }
  3530.     CvGV(cv) = (GV*)SvREFCNT_inc(gv);
  3531.     CvFILEGV(cv) = PL_curcop->cop_filegv;
  3532.     CvSTASH(cv) = PL_curstash;
  3533. #ifdef USE_THREADS
  3534.     CvOWNER(cv) = 0;
  3535.     if (!CvMUTEXP(cv))
  3536.     New(666, CvMUTEXP(cv), 1, perl_mutex);
  3537.     MUTEX_INIT(CvMUTEXP(cv));
  3538. #endif /* USE_THREADS */
  3539.  
  3540.     if (ps)
  3541.     sv_setpv((SV*)cv, ps);
  3542.  
  3543.     if (PL_error_count) {
  3544.     op_free(block);
  3545.     block = Nullop;
  3546.     if (name) {
  3547.         char *s = strrchr(name, ':');
  3548.         s = s ? s+1 : name;
  3549.         if (strEQ(s, "BEGIN")) {
  3550.         char *not_safe =
  3551.             "BEGIN not safe after errors--compilation aborted";
  3552.         if (PL_in_eval & 4)
  3553.             croak(not_safe);
  3554.         else {
  3555.             /* force display of errors found but not reported */
  3556.             sv_catpv(ERRSV, not_safe);
  3557.             croak("%s", SvPVx(ERRSV, PL_na));
  3558.         }
  3559.         }
  3560.     }
  3561.     }
  3562.     if (!block) {
  3563.       noblock:
  3564.     PL_copline = NOLINE;
  3565.     LEAVE_SCOPE(floor);
  3566.     return cv;
  3567.     }
  3568.  
  3569.     if (AvFILLp(PL_comppad_name) < AvFILLp(PL_comppad))
  3570.     av_store(PL_comppad_name, AvFILLp(PL_comppad), Nullsv);
  3571.  
  3572.     if (CvCLONE(cv)) {
  3573.     SV **namep = AvARRAY(PL_comppad_name);
  3574.     for (ix = AvFILLp(PL_comppad); ix > 0; ix--) {
  3575.         SV *namesv;
  3576.  
  3577.         if (SvIMMORTAL(PL_curpad[ix]))
  3578.         continue;
  3579.         /*
  3580.          * The only things that a clonable function needs in its
  3581.          * pad are references to outer lexicals and anonymous subs.
  3582.          * The rest are created anew during cloning.
  3583.          */
  3584.         if (!((namesv = namep[ix]) != Nullsv &&
  3585.           namesv != &PL_sv_undef &&
  3586.           (SvFAKE(namesv) ||
  3587.            *SvPVX(namesv) == '&')))
  3588.         {
  3589.         SvREFCNT_dec(PL_curpad[ix]);
  3590.         PL_curpad[ix] = Nullsv;
  3591.         }
  3592.     }
  3593.     }
  3594.     else {
  3595.     AV *av = newAV();            /* Will be @_ */
  3596.     av_extend(av, 0);
  3597.     av_store(PL_comppad, 0, (SV*)av);
  3598.     AvFLAGS(av) = AVf_REIFY;
  3599.  
  3600.     for (ix = AvFILLp(PL_comppad); ix > 0; ix--) {
  3601.         if (SvIMMORTAL(PL_curpad[ix]))
  3602.         continue;
  3603.         if (!SvPADMY(PL_curpad[ix]))
  3604.         SvPADTMP_on(PL_curpad[ix]);
  3605.     }
  3606.     }
  3607.  
  3608.     CvROOT(cv) = newUNOP(OP_LEAVESUB, 0, scalarseq(block));
  3609.     CvSTART(cv) = LINKLIST(CvROOT(cv));
  3610.     CvROOT(cv)->op_next = 0;
  3611.     peep(CvSTART(cv));
  3612.  
  3613.     if (name) {
  3614.     char *s;
  3615.  
  3616.     if (PERLDB_SUBLINE && PL_curstash != PL_debstash) {
  3617.         SV *sv = NEWSV(0,0);
  3618.         SV *tmpstr = sv_newmortal();
  3619.         GV *db_postponed = gv_fetchpv("DB::postponed", GV_ADDMULTI, SVt_PVHV);
  3620.         CV *cv;
  3621.         HV *hv;
  3622.  
  3623.         sv_setpvf(sv, "%_:%ld-%ld",
  3624.             GvSV(PL_curcop->cop_filegv),
  3625.             (long)PL_subline, (long)PL_curcop->cop_line);
  3626.         gv_efullname3(tmpstr, gv, Nullch);
  3627.         hv_store(GvHV(PL_DBsub), SvPVX(tmpstr), SvCUR(tmpstr), sv, 0);
  3628.         hv = GvHVn(db_postponed);
  3629.         if (HvFILL(hv) > 0 && hv_exists(hv, SvPVX(tmpstr), SvCUR(tmpstr))
  3630.           && (cv = GvCV(db_postponed))) {
  3631.         dSP;
  3632.         PUSHMARK(SP);
  3633.         XPUSHs(tmpstr);
  3634.         PUTBACK;
  3635.         perl_call_sv((SV*)cv, G_DISCARD);
  3636.         }
  3637.     }
  3638.  
  3639.     if ((s = strrchr(name,':')))
  3640.         s++;
  3641.     else
  3642.         s = name;
  3643.     if (strEQ(s, "BEGIN")) {
  3644.         I32 oldscope = PL_scopestack_ix;
  3645.         ENTER;
  3646.         SAVESPTR(PL_compiling.cop_filegv);
  3647.         SAVEI16(PL_compiling.cop_line);
  3648.         save_svref(&PL_rs);
  3649.         sv_setsv(PL_rs, PL_nrs);
  3650.  
  3651.         if (!PL_beginav)
  3652.         PL_beginav = newAV();
  3653.         DEBUG_x( dump_sub(gv) );
  3654.         av_push(PL_beginav, (SV *)cv);
  3655.         GvCV(gv) = 0;
  3656.         call_list(oldscope, PL_beginav);
  3657.  
  3658.         PL_curcop = &PL_compiling;
  3659.         LEAVE;
  3660.     }
  3661.     else if (strEQ(s, "END") && !PL_error_count) {
  3662.         if (!PL_endav)
  3663.         PL_endav = newAV();
  3664.         av_unshift(PL_endav, 1);
  3665.         av_store(PL_endav, 0, (SV *)cv);
  3666.         GvCV(gv) = 0;
  3667.     }
  3668.     else if (strEQ(s, "INIT") && !PL_error_count) {
  3669.         if (!PL_initav)
  3670.         PL_initav = newAV();
  3671.         av_push(PL_initav, SvREFCNT_inc(cv));
  3672.         GvCV(gv) = 0;
  3673.     }
  3674.     }
  3675.  
  3676.   done:
  3677.     PL_copline = NOLINE;
  3678.     LEAVE_SCOPE(floor);
  3679.     return cv;
  3680. }
  3681.  
  3682. void
  3683. newCONSTSUB(HV *stash, char *name, SV *sv)
  3684. {
  3685.     dTHR;
  3686.     U32 oldhints = PL_hints;
  3687.     HV *old_cop_stash = PL_curcop->cop_stash;
  3688.     HV *old_curstash = PL_curstash;
  3689.     line_t oldline = PL_curcop->cop_line;
  3690.     PL_curcop->cop_line = PL_copline;
  3691.  
  3692.     PL_hints &= ~HINT_BLOCK_SCOPE;
  3693.     if(stash)
  3694.     PL_curstash = PL_curcop->cop_stash = stash;
  3695.  
  3696.     newSUB(
  3697.     start_subparse(FALSE, 0),
  3698.     newSVOP(OP_CONST, 0, newSVpv(name,0)),
  3699.     newSVOP(OP_CONST, 0, &PL_sv_no),    /* SvPV(&PL_sv_no) == "" -- GMB */
  3700.     newSTATEOP(0, Nullch, newSVOP(OP_CONST, 0, sv))
  3701.     );
  3702.  
  3703.     PL_hints = oldhints;
  3704.     PL_curcop->cop_stash = old_cop_stash;
  3705.     PL_curstash = old_curstash;
  3706.     PL_curcop->cop_line = oldline;
  3707. }
  3708.  
  3709. CV *
  3710. newXS(char *name, void (*subaddr) (CV * _CPERLproto), char *filename)
  3711. {
  3712.     dTHR;
  3713.     GV *gv = gv_fetchpv(name ? name : "__ANON__", GV_ADDMULTI, SVt_PVCV);
  3714.     register CV *cv;
  3715.  
  3716.     if (cv = (name ? GvCV(gv) : Nullcv)) {
  3717.     if (GvCVGEN(gv)) {
  3718.         /* just a cached method */
  3719.         SvREFCNT_dec(cv);
  3720.         cv = 0;
  3721.     }
  3722.     else if (CvROOT(cv) || CvXSUB(cv) || GvASSUMECV(gv)) {
  3723.         /* already defined (or promised) */
  3724.         if (PL_dowarn && !(CvGV(cv) && GvSTASH(CvGV(cv))
  3725.                 && HvNAME(GvSTASH(CvGV(cv)))
  3726.                 && strEQ(HvNAME(GvSTASH(CvGV(cv))), "autouse"))) {
  3727.         line_t oldline = PL_curcop->cop_line;
  3728.         PL_curcop->cop_line = PL_copline;
  3729.         warn("Subroutine %s redefined",name);
  3730.         PL_curcop->cop_line = oldline;
  3731.         }
  3732.         SvREFCNT_dec(cv);
  3733.         cv = 0;
  3734.     }
  3735.     }
  3736.  
  3737.     if (cv)                /* must reuse cv if autoloaded */
  3738.     cv_undef(cv);
  3739.     else {
  3740.     cv = (CV*)NEWSV(1105,0);
  3741.     sv_upgrade((SV *)cv, SVt_PVCV);
  3742.     if (name) {
  3743.         GvCV(gv) = cv;
  3744.         GvCVGEN(gv) = 0;
  3745.         PL_sub_generation++;
  3746.     }
  3747.     }
  3748.     CvGV(cv) = (GV*)SvREFCNT_inc(gv);
  3749. #ifdef USE_THREADS
  3750.     New(666, CvMUTEXP(cv), 1, perl_mutex);
  3751.     MUTEX_INIT(CvMUTEXP(cv));
  3752.     CvOWNER(cv) = 0;
  3753. #endif /* USE_THREADS */
  3754.     CvFILEGV(cv) = gv_fetchfile(filename);
  3755.     CvXSUB(cv) = subaddr;
  3756.  
  3757.     if (name) {
  3758.     char *s = strrchr(name,':');
  3759.     if (s)
  3760.         s++;
  3761.     else
  3762.         s = name;
  3763.     if (strEQ(s, "BEGIN")) {
  3764.         if (!PL_beginav)
  3765.         PL_beginav = newAV();
  3766.         av_push(PL_beginav, (SV *)cv);
  3767.         GvCV(gv) = 0;
  3768.     }
  3769.     else if (strEQ(s, "END")) {
  3770.         if (!PL_endav)
  3771.         PL_endav = newAV();
  3772.         av_unshift(PL_endav, 1);
  3773.         av_store(PL_endav, 0, (SV *)cv);
  3774.         GvCV(gv) = 0;
  3775.     }
  3776.     else if (strEQ(s, "INIT")) {
  3777.         if (!PL_initav)
  3778.         PL_initav = newAV();
  3779.         av_push(PL_initav, (SV *)cv);
  3780.     }
  3781.     }
  3782.     else
  3783.     CvANON_on(cv);
  3784.  
  3785.     return cv;
  3786. }
  3787.  
  3788. void
  3789. newFORM(I32 floor, OP *o, OP *block)
  3790. {
  3791.     dTHR;
  3792.     register CV *cv;
  3793.     char *name;
  3794.     GV *gv;
  3795.     I32 ix;
  3796.  
  3797.     if (o)
  3798.     name = SvPVx(cSVOPo->op_sv, PL_na);
  3799.     else
  3800.     name = "STDOUT";
  3801.     gv = gv_fetchpv(name,TRUE, SVt_PVFM);
  3802.     GvMULTI_on(gv);
  3803.     if (cv = GvFORM(gv)) {
  3804.     if (PL_dowarn) {
  3805.         line_t oldline = PL_curcop->cop_line;
  3806.  
  3807.         PL_curcop->cop_line = PL_copline;
  3808.         warn("Format %s redefined",name);
  3809.         PL_curcop->cop_line = oldline;
  3810.     }
  3811.     SvREFCNT_dec(cv);
  3812.     }
  3813.     cv = PL_compcv;
  3814.     GvFORM(gv) = cv;
  3815.     CvGV(cv) = (GV*)SvREFCNT_inc(gv);
  3816.     CvFILEGV(cv) = PL_curcop->cop_filegv;
  3817.  
  3818.     for (ix = AvFILLp(PL_comppad); ix > 0; ix--) {
  3819.     if (!SvPADMY(PL_curpad[ix]) && !SvIMMORTAL(PL_curpad[ix]))
  3820.         SvPADTMP_on(PL_curpad[ix]);
  3821.     }
  3822.  
  3823.     CvROOT(cv) = newUNOP(OP_LEAVEWRITE, 0, scalarseq(block));
  3824.     CvSTART(cv) = LINKLIST(CvROOT(cv));
  3825.     CvROOT(cv)->op_next = 0;
  3826.     peep(CvSTART(cv));
  3827.     op_free(o);
  3828.     PL_copline = NOLINE;
  3829.     LEAVE_SCOPE(floor);
  3830. }
  3831.  
  3832. OP *
  3833. newANONLIST(OP *o)
  3834. {
  3835.     return newUNOP(OP_REFGEN, 0,
  3836.     mod(list(convert(OP_ANONLIST, 0, o)), OP_REFGEN));
  3837. }
  3838.  
  3839. OP *
  3840. newANONHASH(OP *o)
  3841. {
  3842.     return newUNOP(OP_REFGEN, 0,
  3843.     mod(list(convert(OP_ANONHASH, 0, o)), OP_REFGEN));
  3844. }
  3845.  
  3846. OP *
  3847. newANONSUB(I32 floor, OP *proto, OP *block)
  3848. {
  3849.     return newUNOP(OP_REFGEN, 0,
  3850.     newSVOP(OP_ANONCODE, 0, (SV*)newSUB(floor, 0, proto, block)));
  3851. }
  3852.  
  3853. OP *
  3854. oopsAV(OP *o)
  3855. {
  3856.     switch (o->op_type) {
  3857.     case OP_PADSV:
  3858.     o->op_type = OP_PADAV;
  3859.     o->op_ppaddr = ppaddr[OP_PADAV];
  3860.     return ref(newUNOP(OP_RV2AV, 0, scalar(o)), OP_RV2AV);
  3861.     
  3862.     case OP_RV2SV:
  3863.     o->op_type = OP_RV2AV;
  3864.     o->op_ppaddr = ppaddr[OP_RV2AV];
  3865.     ref(o, OP_RV2AV);
  3866.     break;
  3867.  
  3868.     default:
  3869.     warn("oops: oopsAV");
  3870.     break;
  3871.     }
  3872.     return o;
  3873. }
  3874.  
  3875. OP *
  3876. oopsHV(OP *o)
  3877. {
  3878.     switch (o->op_type) {
  3879.     case OP_PADSV:
  3880.     case OP_PADAV:
  3881.     o->op_type = OP_PADHV;
  3882.     o->op_ppaddr = ppaddr[OP_PADHV];
  3883.     return ref(newUNOP(OP_RV2HV, 0, scalar(o)), OP_RV2HV);
  3884.  
  3885.     case OP_RV2SV:
  3886.     case OP_RV2AV:
  3887.     o->op_type = OP_RV2HV;
  3888.     o->op_ppaddr = ppaddr[OP_RV2HV];
  3889.     ref(o, OP_RV2HV);
  3890.     break;
  3891.  
  3892.     default:
  3893.     warn("oops: oopsHV");
  3894.     break;
  3895.     }
  3896.     return o;
  3897. }
  3898.  
  3899. OP *
  3900. newAVREF(OP *o)
  3901. {
  3902.     if (o->op_type == OP_PADANY) {
  3903.     o->op_type = OP_PADAV;
  3904.     o->op_ppaddr = ppaddr[OP_PADAV];
  3905.     return o;
  3906.     }
  3907.     return newUNOP(OP_RV2AV, 0, scalar(o));
  3908. }
  3909.  
  3910. OP *
  3911. newGVREF(I32 type, OP *o)
  3912. {
  3913.     if (type == OP_MAPSTART)
  3914.     return newUNOP(OP_NULL, 0, o);
  3915.     return ref(newUNOP(OP_RV2GV, OPf_REF, o), type);
  3916. }
  3917.  
  3918. OP *
  3919. newHVREF(OP *o)
  3920. {
  3921.     if (o->op_type == OP_PADANY) {
  3922.     o->op_type = OP_PADHV;
  3923.     o->op_ppaddr = ppaddr[OP_PADHV];
  3924.     return o;
  3925.     }
  3926.     return newUNOP(OP_RV2HV, 0, scalar(o));
  3927. }
  3928.  
  3929. OP *
  3930. oopsCV(OP *o)
  3931. {
  3932.     croak("NOT IMPL LINE %d",__LINE__);
  3933.     /* STUB */
  3934.     return o;
  3935. }
  3936.  
  3937. OP *
  3938. newCVREF(I32 flags, OP *o)
  3939. {
  3940.     return newUNOP(OP_RV2CV, flags, scalar(o));
  3941. }
  3942.  
  3943. OP *
  3944. newSVREF(OP *o)
  3945. {
  3946.     if (o->op_type == OP_PADANY) {
  3947.     o->op_type = OP_PADSV;
  3948.     o->op_ppaddr = ppaddr[OP_PADSV];
  3949.     return o;
  3950.     }
  3951.     else if (o->op_type == OP_THREADSV && !(o->op_flags & OPpDONE_SVREF)) {
  3952.     o->op_flags |= OPpDONE_SVREF;
  3953.     return o;
  3954.     }
  3955.     return newUNOP(OP_RV2SV, 0, scalar(o));
  3956. }
  3957.  
  3958. /* Check routines. */
  3959.  
  3960. OP *
  3961. ck_anoncode(OP *o)
  3962. {
  3963.     PADOFFSET ix;
  3964.     SV* name;
  3965.  
  3966.     name = NEWSV(1106,0);
  3967.     sv_upgrade(name, SVt_PVNV);
  3968.     sv_setpvn(name, "&", 1);
  3969.     SvIVX(name) = -1;
  3970.     SvNVX(name) = 1;
  3971.     ix = pad_alloc(o->op_type, SVs_PADMY);
  3972.     av_store(PL_comppad_name, ix, name);
  3973.     av_store(PL_comppad, ix, cSVOPo->op_sv);
  3974.     SvPADMY_on(cSVOPo->op_sv);
  3975.     cSVOPo->op_sv = Nullsv;
  3976.     cSVOPo->op_targ = ix;
  3977.     return o;
  3978. }
  3979.  
  3980. OP *
  3981. ck_bitop(OP *o)
  3982. {
  3983.     o->op_private = PL_hints;
  3984.     return o;
  3985. }
  3986.  
  3987. OP *
  3988. ck_concat(OP *o)
  3989. {
  3990.     if (cUNOPo->op_first->op_type == OP_CONCAT)
  3991.     o->op_flags |= OPf_STACKED;
  3992.     return o;
  3993. }
  3994.  
  3995. OP *
  3996. ck_spair(OP *o)
  3997. {
  3998.     if (o->op_flags & OPf_KIDS) {
  3999.     OP* newop;
  4000.     OP* kid;
  4001.     OPCODE type = o->op_type;
  4002.     o = modkids(ck_fun(o), type);
  4003.     kid = cUNOPo->op_first;
  4004.     newop = kUNOP->op_first->op_sibling;
  4005.     if (newop &&
  4006.         (newop->op_sibling ||
  4007.          !(opargs[newop->op_type] & OA_RETSCALAR) ||
  4008.          newop->op_type == OP_PADAV || newop->op_type == OP_PADHV ||
  4009.          newop->op_type == OP_RV2AV || newop->op_type == OP_RV2HV)) {
  4010.     
  4011.         return o;
  4012.     }
  4013.     op_free(kUNOP->op_first);
  4014.     kUNOP->op_first = newop;
  4015.     }
  4016.     o->op_ppaddr = ppaddr[++o->op_type];
  4017.     return ck_fun(o);
  4018. }
  4019.  
  4020. OP *
  4021. ck_delete(OP *o)
  4022. {
  4023.     o = ck_fun(o);
  4024.     o->op_private = 0;
  4025.     if (o->op_flags & OPf_KIDS) {
  4026.     OP *kid = cUNOPo->op_first;
  4027.     if (kid->op_type == OP_HSLICE)
  4028.         o->op_private |= OPpSLICE;
  4029.     else if (kid->op_type != OP_HELEM)
  4030.         croak("%s argument is not a HASH element or slice",
  4031.           op_desc[o->op_type]);
  4032.     null(kid);
  4033.     }
  4034.     return o;
  4035. }
  4036.  
  4037. OP *
  4038. ck_eof(OP *o)
  4039. {
  4040.     I32 type = o->op_type;
  4041.  
  4042.     if (o->op_flags & OPf_KIDS) {
  4043.     if (cLISTOPo->op_first->op_type == OP_STUB) {
  4044.         op_free(o);
  4045.         o = newUNOP(type, OPf_SPECIAL,
  4046.         newGVOP(OP_GV, 0, gv_fetchpv("main::ARGV", TRUE, SVt_PVAV)));
  4047.     }
  4048.     return ck_fun(o);
  4049.     }
  4050.     return o;
  4051. }
  4052.  
  4053. OP *
  4054. ck_eval(OP *o)
  4055. {
  4056.     PL_hints |= HINT_BLOCK_SCOPE;
  4057.     if (o->op_flags & OPf_KIDS) {
  4058.     SVOP *kid = (SVOP*)cUNOPo->op_first;
  4059.  
  4060.     if (!kid) {
  4061.         o->op_flags &= ~OPf_KIDS;
  4062.         null(o);
  4063.     }
  4064.     else if (kid->op_type == OP_LINESEQ) {
  4065.         LOGOP *enter;
  4066.  
  4067.         kid->op_next = o->op_next;
  4068.         cUNOPo->op_first = 0;
  4069.         op_free(o);
  4070.  
  4071.         Newz(1101, enter, 1, LOGOP);
  4072.         enter->op_type = OP_ENTERTRY;
  4073.         enter->op_ppaddr = ppaddr[OP_ENTERTRY];
  4074.         enter->op_private = 0;
  4075.  
  4076.         /* establish postfix order */
  4077.         enter->op_next = (OP*)enter;
  4078.  
  4079.         o = prepend_elem(OP_LINESEQ, (OP*)enter, (OP*)kid);
  4080.         o->op_type = OP_LEAVETRY;
  4081.         o->op_ppaddr = ppaddr[OP_LEAVETRY];
  4082.         enter->op_other = o;
  4083.         return o;
  4084.     }
  4085.     else
  4086.         scalar((OP*)kid);
  4087.     }
  4088.     else {
  4089.     op_free(o);
  4090.     o = newUNOP(OP_ENTEREVAL, 0, newDEFSVOP());
  4091.     }
  4092.     o->op_targ = (PADOFFSET)PL_hints;
  4093.     return o;
  4094. }
  4095.  
  4096. OP *
  4097. ck_exec(OP *o)
  4098. {
  4099.     OP *kid;
  4100.     if (o->op_flags & OPf_STACKED) {
  4101.     o = ck_fun(o);
  4102.     kid = cUNOPo->op_first->op_sibling;
  4103.     if (kid->op_type == OP_RV2GV)
  4104.         null(kid);
  4105.     }
  4106.     else
  4107.     o = listkids(o);
  4108.     return o;
  4109. }
  4110.  
  4111. OP *
  4112. ck_exists(OP *o)
  4113. {
  4114.     o = ck_fun(o);
  4115.     if (o->op_flags & OPf_KIDS) {
  4116.     OP *kid = cUNOPo->op_first;
  4117.     if (kid->op_type != OP_HELEM)
  4118.         croak("%s argument is not a HASH element", op_desc[o->op_type]);
  4119.     null(kid);
  4120.     }
  4121.     return o;
  4122. }
  4123.  
  4124. OP *
  4125. ck_gvconst(register OP *o)
  4126. {
  4127.     o = fold_constants(o);
  4128.     if (o->op_type == OP_CONST)
  4129.     o->op_type = OP_GV;
  4130.     return o;
  4131. }
  4132.  
  4133. OP *
  4134. ck_rvconst(register OP *o)
  4135. {
  4136.     dTHR;
  4137.     SVOP *kid = (SVOP*)cUNOPo->op_first;
  4138.  
  4139.     o->op_private |= (PL_hints & HINT_STRICT_REFS);
  4140.     if (kid->op_type == OP_CONST) {
  4141.     char *name;
  4142.     int iscv;
  4143.     GV *gv;
  4144.  
  4145.     name = SvPV(kid->op_sv, PL_na);
  4146.     if ((PL_hints & HINT_STRICT_REFS) && (kid->op_private & OPpCONST_BARE)) {
  4147.         char *badthing = Nullch;
  4148.         switch (o->op_type) {
  4149.         case OP_RV2SV:
  4150.         badthing = "a SCALAR";
  4151.         break;
  4152.         case OP_RV2AV:
  4153.         badthing = "an ARRAY";
  4154.         break;
  4155.         case OP_RV2HV:
  4156.         badthing = "a HASH";
  4157.         break;
  4158.         }
  4159.         if (badthing)
  4160.         croak(
  4161.       "Can't use bareword (\"%s\") as %s ref while \"strict refs\" in use",
  4162.               name, badthing);
  4163.     }
  4164.     /*
  4165.      * This is a little tricky.  We only want to add the symbol if we
  4166.      * didn't add it in the lexer.  Otherwise we get duplicate strict
  4167.      * warnings.  But if we didn't add it in the lexer, we must at
  4168.      * least pretend like we wanted to add it even if it existed before,
  4169.      * or we get possible typo warnings.  OPpCONST_ENTERED says
  4170.      * whether the lexer already added THIS instance of this symbol.
  4171.      */
  4172.     iscv = (o->op_type == OP_RV2CV) * 2;
  4173.     do {
  4174.         gv = gv_fetchpv(name,
  4175.         iscv | !(kid->op_private & OPpCONST_ENTERED),
  4176.         iscv
  4177.             ? SVt_PVCV
  4178.             : o->op_type == OP_RV2SV
  4179.             ? SVt_PV
  4180.             : o->op_type == OP_RV2AV
  4181.                 ? SVt_PVAV
  4182.                 : o->op_type == OP_RV2HV
  4183.                 ? SVt_PVHV
  4184.                 : SVt_PVGV);
  4185.     } while (!gv && !(kid->op_private & OPpCONST_ENTERED) && !iscv++);
  4186.     if (gv) {
  4187.         kid->op_type = OP_GV;
  4188.         SvREFCNT_dec(kid->op_sv);
  4189.         kid->op_sv = SvREFCNT_inc(gv);
  4190.     }
  4191.     }
  4192.     return o;
  4193. }
  4194.  
  4195. OP *
  4196. ck_ftst(OP *o)
  4197. {
  4198.     dTHR;
  4199.     I32 type = o->op_type;
  4200.  
  4201.     if (o->op_flags & OPf_REF)
  4202.     return o;
  4203.  
  4204.     if (o->op_flags & OPf_KIDS && cUNOPo->op_first->op_type != OP_STUB) {
  4205.     SVOP *kid = (SVOP*)cUNOPo->op_first;
  4206.  
  4207.     if (kid->op_type == OP_CONST && (kid->op_private & OPpCONST_BARE)) {
  4208.         OP *newop = newGVOP(type, OPf_REF,
  4209.         gv_fetchpv(SvPVx(kid->op_sv, PL_na), TRUE, SVt_PVIO));
  4210.         op_free(o);
  4211.         return newop;
  4212.     }
  4213.     }
  4214.     else {
  4215.     op_free(o);
  4216.     if (type == OP_FTTTY)
  4217.            return newGVOP(type, OPf_REF, gv_fetchpv("main::STDIN", TRUE,
  4218.                 SVt_PVIO));
  4219.     else
  4220.         return newUNOP(type, 0, newDEFSVOP());
  4221.     }
  4222.     return o;
  4223. }
  4224.  
  4225. OP *
  4226. ck_fun(OP *o)
  4227. {
  4228.     dTHR;
  4229.     register OP *kid;
  4230.     OP **tokid;
  4231.     OP *sibl;
  4232.     I32 numargs = 0;
  4233.     int type = o->op_type;
  4234.     register I32 oa = opargs[type] >> OASHIFT;
  4235.  
  4236.     if (o->op_flags & OPf_STACKED) {
  4237.     if ((oa & OA_OPTIONAL) && (oa >> 4) && !((oa >> 4) & OA_OPTIONAL))
  4238.         oa &= ~OA_OPTIONAL;
  4239.     else
  4240.         return no_fh_allowed(o);
  4241.     }
  4242.  
  4243.     if (o->op_flags & OPf_KIDS) {
  4244.     tokid = &cLISTOPo->op_first;
  4245.     kid = cLISTOPo->op_first;
  4246.     if (kid->op_type == OP_PUSHMARK ||
  4247.         kid->op_type == OP_NULL && kid->op_targ == OP_PUSHMARK)
  4248.     {
  4249.         tokid = &kid->op_sibling;
  4250.         kid = kid->op_sibling;
  4251.     }
  4252.     if (!kid && opargs[type] & OA_DEFGV)
  4253.         *tokid = kid = newDEFSVOP();
  4254.  
  4255.     while (oa && kid) {
  4256.         numargs++;
  4257.         sibl = kid->op_sibling;
  4258.         switch (oa & 7) {
  4259.         case OA_SCALAR:
  4260.         scalar(kid);
  4261.         break;
  4262.         case OA_LIST:
  4263.         if (oa < 16) {
  4264.             kid = 0;
  4265.             continue;
  4266.         }
  4267.         else
  4268.             list(kid);
  4269.         break;
  4270.         case OA_AVREF:
  4271.         if (kid->op_type == OP_CONST &&
  4272.           (kid->op_private & OPpCONST_BARE)) {
  4273.             char *name = SvPVx(((SVOP*)kid)->op_sv, PL_na);
  4274.             OP *newop = newAVREF(newGVOP(OP_GV, 0,
  4275.             gv_fetchpv(name, TRUE, SVt_PVAV) ));
  4276.             if (PL_dowarn)
  4277.             warn("Array @%s missing the @ in argument %ld of %s()",
  4278.                 name, (long)numargs, op_desc[type]);
  4279.             op_free(kid);
  4280.             kid = newop;
  4281.             kid->op_sibling = sibl;
  4282.             *tokid = kid;
  4283.         }
  4284.         else if (kid->op_type != OP_RV2AV && kid->op_type != OP_PADAV)
  4285.             bad_type(numargs, "array", op_desc[o->op_type], kid);
  4286.         mod(kid, type);
  4287.         break;
  4288.         case OA_HVREF:
  4289.         if (kid->op_type == OP_CONST &&
  4290.           (kid->op_private & OPpCONST_BARE)) {
  4291.             char *name = SvPVx(((SVOP*)kid)->op_sv, PL_na);
  4292.             OP *newop = newHVREF(newGVOP(OP_GV, 0,
  4293.             gv_fetchpv(name, TRUE, SVt_PVHV) ));
  4294.             if (PL_dowarn)
  4295.             warn("Hash %%%s missing the %% in argument %ld of %s()",
  4296.                 name, (long)numargs, op_desc[type]);
  4297.             op_free(kid);
  4298.             kid = newop;
  4299.             kid->op_sibling = sibl;
  4300.             *tokid = kid;
  4301.         }
  4302.         else if (kid->op_type != OP_RV2HV && kid->op_type != OP_PADHV)
  4303.             bad_type(numargs, "hash", op_desc[o->op_type], kid);
  4304.         mod(kid, type);
  4305.         break;
  4306.         case OA_CVREF:
  4307.         {
  4308.             OP *newop = newUNOP(OP_NULL, 0, kid);
  4309.             kid->op_sibling = 0;
  4310.             linklist(kid);
  4311.             newop->op_next = newop;
  4312.             kid = newop;
  4313.             kid->op_sibling = sibl;
  4314.             *tokid = kid;
  4315.         }
  4316.         break;
  4317.         case OA_FILEREF:
  4318.         if (kid->op_type != OP_GV && kid->op_type != OP_RV2GV) {
  4319.             if (kid->op_type == OP_CONST &&
  4320.               (kid->op_private & OPpCONST_BARE)) {
  4321.             OP *newop = newGVOP(OP_GV, 0,
  4322.                 gv_fetchpv(SvPVx(((SVOP*)kid)->op_sv, PL_na), TRUE,
  4323.                     SVt_PVIO) );
  4324.             op_free(kid);
  4325.             kid = newop;
  4326.             }
  4327.             else {
  4328.             kid->op_sibling = 0;
  4329.             kid = newUNOP(OP_RV2GV, 0, scalar(kid));
  4330.             }
  4331.             kid->op_sibling = sibl;
  4332.             *tokid = kid;
  4333.         }
  4334.         scalar(kid);
  4335.         break;
  4336.         case OA_SCALARREF:
  4337.         mod(scalar(kid), type);
  4338.         break;
  4339.         }
  4340.         oa >>= 4;
  4341.         tokid = &kid->op_sibling;
  4342.         kid = kid->op_sibling;
  4343.     }
  4344.     o->op_private |= numargs;
  4345.     if (kid)
  4346.         return too_many_arguments(o,op_desc[o->op_type]);
  4347.     listkids(o);
  4348.     }
  4349.     else if (opargs[type] & OA_DEFGV) {
  4350.     op_free(o);
  4351.     return newUNOP(type, 0, newDEFSVOP());
  4352.     }
  4353.  
  4354.     if (oa) {
  4355.     while (oa & OA_OPTIONAL)
  4356.         oa >>= 4;
  4357.     if (oa && oa != OA_LIST)
  4358.         return too_few_arguments(o,op_desc[o->op_type]);
  4359.     }
  4360.     return o;
  4361. }
  4362.  
  4363. OP *
  4364. ck_glob(OP *o)
  4365. {
  4366.     GV *gv;
  4367.  
  4368.     if ((o->op_flags & OPf_KIDS) && !cLISTOPo->op_first->op_sibling)
  4369.     append_elem(OP_GLOB, o, newDEFSVOP());
  4370.  
  4371.     if (!((gv = gv_fetchpv("glob", FALSE, SVt_PVCV)) && GvIMPORTED_CV(gv)))
  4372.     gv = gv_fetchpv("CORE::GLOBAL::glob", FALSE, SVt_PVCV);
  4373.  
  4374.     if (gv && GvIMPORTED_CV(gv)) {
  4375.     static int glob_index;
  4376.  
  4377.     append_elem(OP_GLOB, o,
  4378.             newSVOP(OP_CONST, 0, newSViv(glob_index++)));
  4379.     o->op_type = OP_LIST;
  4380.     o->op_ppaddr = ppaddr[OP_LIST];
  4381.     cLISTOPo->op_first->op_type = OP_PUSHMARK;
  4382.     cLISTOPo->op_first->op_ppaddr = ppaddr[OP_PUSHMARK];
  4383.     o = newUNOP(OP_ENTERSUB, OPf_STACKED,
  4384.             append_elem(OP_LIST, o,
  4385.                 scalar(newUNOP(OP_RV2CV, 0,
  4386.                            newGVOP(OP_GV, 0, gv)))));
  4387.     o = newUNOP(OP_NULL, 0, ck_subr(o));
  4388.     o->op_targ = OP_GLOB;        /* hint at what it used to be */
  4389.     return o;
  4390.     }
  4391.     gv = newGVgen("main");
  4392.     gv_IOadd(gv);
  4393.     append_elem(OP_GLOB, o, newGVOP(OP_GV, 0, gv));
  4394.     scalarkids(o);
  4395.     return ck_fun(o);
  4396. }
  4397.  
  4398. OP *
  4399. ck_grep(OP *o)
  4400. {
  4401.     LOGOP *gwop;
  4402.     OP *kid;
  4403.     OPCODE type = o->op_type == OP_GREPSTART ? OP_GREPWHILE : OP_MAPWHILE;
  4404.  
  4405.     o->op_ppaddr = ppaddr[OP_GREPSTART];
  4406.     Newz(1101, gwop, 1, LOGOP);
  4407.  
  4408.     if (o->op_flags & OPf_STACKED) {
  4409.     OP* k;
  4410.     o = ck_sort(o);
  4411.         kid = cLISTOPo->op_first->op_sibling;
  4412.     for (k = cLISTOPo->op_first->op_sibling->op_next; k; k = k->op_next) {
  4413.         kid = k;
  4414.     }
  4415.     kid->op_next = (OP*)gwop;
  4416.     o->op_flags &= ~OPf_STACKED;
  4417.     }
  4418.     kid = cLISTOPo->op_first->op_sibling;
  4419.     if (type == OP_MAPWHILE)
  4420.     list(kid);
  4421.     else
  4422.     scalar(kid);
  4423.     o = ck_fun(o);
  4424.     if (PL_error_count)
  4425.     return o;
  4426.     kid = cLISTOPo->op_first->op_sibling;
  4427.     if (kid->op_type != OP_NULL)
  4428.     croak("panic: ck_grep");
  4429.     kid = kUNOP->op_first;
  4430.  
  4431.     gwop->op_type = type;
  4432.     gwop->op_ppaddr = ppaddr[type];
  4433.     gwop->op_first = listkids(o);
  4434.     gwop->op_flags |= OPf_KIDS;
  4435.     gwop->op_private = 1;
  4436.     gwop->op_other = LINKLIST(kid);
  4437.     gwop->op_targ = pad_alloc(type, SVs_PADTMP);
  4438.     kid->op_next = (OP*)gwop;
  4439.  
  4440.     kid = cLISTOPo->op_first->op_sibling;
  4441.     if (!kid || !kid->op_sibling)
  4442.     return too_few_arguments(o,op_desc[o->op_type]);
  4443.     for (kid = kid->op_sibling; kid; kid = kid->op_sibling)
  4444.     mod(kid, OP_GREPSTART);
  4445.  
  4446.     return (OP*)gwop;
  4447. }
  4448.  
  4449. OP *
  4450. ck_index(OP *o)
  4451. {
  4452.     if (o->op_flags & OPf_KIDS) {
  4453.     OP *kid = cLISTOPo->op_first->op_sibling;    /* get past pushmark */
  4454.     if (kid && kid->op_type == OP_CONST)
  4455.         fbm_compile(((SVOP*)kid)->op_sv, 0);
  4456.     }
  4457.     return ck_fun(o);
  4458. }
  4459.  
  4460. OP *
  4461. ck_lengthconst(OP *o)
  4462. {
  4463.     /* XXX length optimization goes here */
  4464.     return ck_fun(o);
  4465. }
  4466.  
  4467. OP *
  4468. ck_lfun(OP *o)
  4469. {
  4470.     OPCODE type = o->op_type;
  4471.     return modkids(ck_fun(o), type);
  4472. }
  4473.  
  4474. OP *
  4475. ck_rfun(OP *o)
  4476. {
  4477.     OPCODE type = o->op_type;
  4478.     return refkids(ck_fun(o), type);
  4479. }
  4480.  
  4481. OP *
  4482. ck_listiob(OP *o)
  4483. {
  4484.     register OP *kid;
  4485.  
  4486.     kid = cLISTOPo->op_first;
  4487.     if (!kid) {
  4488.     o = force_list(o);
  4489.     kid = cLISTOPo->op_first;
  4490.     }
  4491.     if (kid->op_type == OP_PUSHMARK)
  4492.     kid = kid->op_sibling;
  4493.     if (kid && o->op_flags & OPf_STACKED)
  4494.     kid = kid->op_sibling;
  4495.     else if (kid && !kid->op_sibling) {        /* print HANDLE; */
  4496.     if (kid->op_type == OP_CONST && kid->op_private & OPpCONST_BARE) {
  4497.         o->op_flags |= OPf_STACKED;    /* make it a filehandle */
  4498.         kid = newUNOP(OP_RV2GV, OPf_REF, scalar(kid));
  4499.         cLISTOPo->op_first->op_sibling = kid;
  4500.         cLISTOPo->op_last = kid;
  4501.         kid = kid->op_sibling;
  4502.     }
  4503.     }
  4504.     
  4505.     if (!kid)
  4506.     append_elem(o->op_type, o, newDEFSVOP());
  4507.  
  4508.     o = listkids(o);
  4509.  
  4510.     o->op_private = 0;
  4511. #ifdef USE_LOCALE
  4512.     if (PL_hints & HINT_LOCALE)
  4513.     o->op_private |= OPpLOCALE;
  4514. #endif
  4515.  
  4516.     return o;
  4517. }
  4518.  
  4519. OP *
  4520. ck_fun_locale(OP *o)
  4521. {
  4522.     o = ck_fun(o);
  4523.  
  4524.     o->op_private = 0;
  4525. #ifdef USE_LOCALE
  4526.     if (PL_hints & HINT_LOCALE)
  4527.     o->op_private |= OPpLOCALE;
  4528. #endif
  4529.  
  4530.     return o;
  4531. }
  4532.  
  4533. OP *
  4534. ck_scmp(OP *o)
  4535. {
  4536.     o->op_private = 0;
  4537. #ifdef USE_LOCALE
  4538.     if (PL_hints & HINT_LOCALE)
  4539.     o->op_private |= OPpLOCALE;
  4540. #endif
  4541.  
  4542.     return o;
  4543. }
  4544.  
  4545. OP *
  4546. ck_match(OP *o)
  4547. {
  4548.     o->op_private |= OPpRUNTIME;
  4549.     return o;
  4550. }
  4551.  
  4552. OP *
  4553. ck_null(OP *o)
  4554. {
  4555.     return o;
  4556. }
  4557.  
  4558. OP *
  4559. ck_repeat(OP *o)
  4560. {
  4561.     if (cBINOPo->op_first->op_flags & OPf_PARENS) {
  4562.     o->op_private |= OPpREPEAT_DOLIST;
  4563.     cBINOPo->op_first = force_list(cBINOPo->op_first);
  4564.     }
  4565.     else
  4566.     scalar(o);
  4567.     return o;
  4568. }
  4569.  
  4570. OP *
  4571. ck_require(OP *o)
  4572. {
  4573.     if (o->op_flags & OPf_KIDS) {    /* Shall we supply missing .pm? */
  4574.     SVOP *kid = (SVOP*)cUNOPo->op_first;
  4575.  
  4576.     if (kid->op_type == OP_CONST && (kid->op_private & OPpCONST_BARE)) {
  4577.         char *s;
  4578.         for (s = SvPVX(kid->op_sv); *s; s++) {
  4579.         if (*s == ':' && s[1] == ':') {
  4580.             *s = '/';
  4581.             Move(s+2, s+1, strlen(s+2)+1, char);
  4582.             --SvCUR(kid->op_sv);
  4583.         }
  4584.         }
  4585.         sv_catpvn(kid->op_sv, ".pm", 3);
  4586.     }
  4587.     }
  4588.     return ck_fun(o);
  4589. }
  4590.  
  4591. OP *
  4592. ck_retarget(OP *o)
  4593. {
  4594.     croak("NOT IMPL LINE %d",__LINE__);
  4595.     /* STUB */
  4596.     return o;
  4597. }
  4598.  
  4599. OP *
  4600. ck_select(OP *o)
  4601. {
  4602.     OP* kid;
  4603.     if (o->op_flags & OPf_KIDS) {
  4604.     kid = cLISTOPo->op_first->op_sibling;    /* get past pushmark */
  4605.     if (kid && kid->op_sibling) {
  4606.         o->op_type = OP_SSELECT;
  4607.         o->op_ppaddr = ppaddr[OP_SSELECT];
  4608.         o = ck_fun(o);
  4609.         return fold_constants(o);
  4610.     }
  4611.     }
  4612.     o = ck_fun(o);
  4613.     kid = cLISTOPo->op_first->op_sibling;    /* get past pushmark */
  4614.     if (kid && kid->op_type == OP_RV2GV)
  4615.     kid->op_private &= ~HINT_STRICT_REFS;
  4616.     return o;
  4617. }
  4618.  
  4619. OP *
  4620. ck_shift(OP *o)
  4621. {
  4622.     I32 type = o->op_type;
  4623.  
  4624.     if (!(o->op_flags & OPf_KIDS)) {
  4625.     OP *argop;
  4626.     
  4627.     op_free(o);
  4628. #ifdef USE_THREADS
  4629.     if (!CvUNIQUE(PL_compcv)) {
  4630.         argop = newOP(OP_PADAV, OPf_REF);
  4631.         argop->op_targ = 0;        /* PL_curpad[0] is @_ */
  4632.     }
  4633.     else {
  4634.         argop = newUNOP(OP_RV2AV, 0,
  4635.         scalar(newGVOP(OP_GV, 0,
  4636.             gv_fetchpv("ARGV", TRUE, SVt_PVAV))));
  4637.     }
  4638. #else
  4639.     argop = newUNOP(OP_RV2AV, 0,
  4640.         scalar(newGVOP(OP_GV, 0, !CvUNIQUE(PL_compcv) ?
  4641.                PL_defgv : gv_fetchpv("ARGV", TRUE, SVt_PVAV))));
  4642. #endif /* USE_THREADS */
  4643.     return newUNOP(type, 0, scalar(argop));
  4644.     }
  4645.     return scalar(modkids(ck_fun(o), type));
  4646. }
  4647.  
  4648. OP *
  4649. ck_sort(OP *o)
  4650. {
  4651.     o->op_private = 0;
  4652. #ifdef USE_LOCALE
  4653.     if (PL_hints & HINT_LOCALE)
  4654.     o->op_private |= OPpLOCALE;
  4655. #endif
  4656.  
  4657.     if (o->op_flags & OPf_STACKED) {
  4658.     OP *kid = cLISTOPo->op_first->op_sibling;    /* get past pushmark */
  4659.     OP *k;
  4660.     kid = kUNOP->op_first;                /* get past rv2gv */
  4661.  
  4662.     if (kid->op_type == OP_SCOPE || kid->op_type == OP_LEAVE) {
  4663.         linklist(kid);
  4664.         if (kid->op_type == OP_SCOPE) {
  4665.         k = kid->op_next;
  4666.         kid->op_next = 0;
  4667.         }
  4668.         else if (kid->op_type == OP_LEAVE) {
  4669.         if (o->op_type == OP_SORT) {
  4670.             null(kid);            /* wipe out leave */
  4671.             kid->op_next = kid;
  4672.  
  4673.             for (k = kLISTOP->op_first->op_next; k; k = k->op_next) {
  4674.             if (k->op_next == kid)
  4675.                 k->op_next = 0;
  4676.             }
  4677.         }
  4678.         else
  4679.             kid->op_next = 0;        /* just disconnect the leave */
  4680.         k = kLISTOP->op_first;
  4681.         }
  4682.         peep(k);
  4683.  
  4684.         kid = cLISTOPo->op_first->op_sibling;    /* get past pushmark */
  4685.         null(kid);                    /* wipe out rv2gv */
  4686.         if (o->op_type == OP_SORT)
  4687.         kid->op_next = kid;
  4688.         else
  4689.         kid->op_next = k;
  4690.         o->op_flags |= OPf_SPECIAL;
  4691.     }
  4692.     }
  4693.  
  4694.     return o;
  4695. }
  4696.  
  4697. OP *
  4698. ck_split(OP *o)
  4699. {
  4700.     register OP *kid;
  4701.  
  4702.     if (o->op_flags & OPf_STACKED)
  4703.     return no_fh_allowed(o);
  4704.  
  4705.     kid = cLISTOPo->op_first;
  4706.     if (kid->op_type != OP_NULL)
  4707.     croak("panic: ck_split");
  4708.     kid = kid->op_sibling;
  4709.     op_free(cLISTOPo->op_first);
  4710.     cLISTOPo->op_first = kid;
  4711.     if (!kid) {
  4712.     cLISTOPo->op_first = kid = newSVOP(OP_CONST, 0, newSVpv(" ", 1));
  4713.     cLISTOPo->op_last = kid; /* There was only one element previously */
  4714.     }
  4715.  
  4716.     if (kid->op_type != OP_MATCH) {
  4717.     OP *sibl = kid->op_sibling;
  4718.     kid->op_sibling = 0;
  4719.     kid = pmruntime( newPMOP(OP_MATCH, OPf_SPECIAL), kid, Nullop);
  4720.     if (cLISTOPo->op_first == cLISTOPo->op_last)
  4721.         cLISTOPo->op_last = kid;
  4722.     cLISTOPo->op_first = kid;
  4723.     kid->op_sibling = sibl;
  4724.     }
  4725.  
  4726.     kid->op_type = OP_PUSHRE;
  4727.     kid->op_ppaddr = ppaddr[OP_PUSHRE];
  4728.     scalar(kid);
  4729.  
  4730.     if (!kid->op_sibling)
  4731.     append_elem(OP_SPLIT, o, newDEFSVOP());
  4732.  
  4733.     kid = kid->op_sibling;
  4734.     scalar(kid);
  4735.  
  4736.     if (!kid->op_sibling)
  4737.     append_elem(OP_SPLIT, o, newSVOP(OP_CONST, 0, newSViv(0)));
  4738.  
  4739.     kid = kid->op_sibling;
  4740.     scalar(kid);
  4741.  
  4742.     if (kid->op_sibling)
  4743.     return too_many_arguments(o,op_desc[o->op_type]);
  4744.  
  4745.     return o;
  4746. }
  4747.  
  4748. OP *
  4749. ck_subr(OP *o)
  4750. {
  4751.     dTHR;
  4752.     OP *prev = ((cUNOPo->op_first->op_sibling)
  4753.          ? cUNOPo : ((UNOP*)cUNOPo->op_first))->op_first;
  4754.     OP *o2 = prev->op_sibling;
  4755.     OP *cvop;
  4756.     char *proto = 0;
  4757.     CV *cv = 0;
  4758.     GV *namegv = 0;
  4759.     int optional = 0;
  4760.     I32 arg = 0;
  4761.  
  4762.     for (cvop = o2; cvop->op_sibling; cvop = cvop->op_sibling) ;
  4763.     if (cvop->op_type == OP_RV2CV) {
  4764.     SVOP* tmpop;
  4765.     o->op_private |= (cvop->op_private & OPpENTERSUB_AMPER);
  4766.     null(cvop);        /* disable rv2cv */
  4767.     tmpop = (SVOP*)((UNOP*)cvop)->op_first;
  4768.     if (tmpop->op_type == OP_GV) {
  4769.         cv = GvCVu(tmpop->op_sv);
  4770.         if (cv && SvPOK(cv) && !(o->op_private & OPpENTERSUB_AMPER)) {
  4771.         namegv = CvANON(cv) ? (GV*)tmpop->op_sv : CvGV(cv);
  4772.         proto = SvPV((SV*)cv, PL_na);
  4773.         }
  4774.     }
  4775.     }
  4776.     o->op_private |= (PL_hints & HINT_STRICT_REFS);
  4777.     if (PERLDB_SUB && PL_curstash != PL_debstash)
  4778.     o->op_private |= OPpENTERSUB_DB;
  4779.     while (o2 != cvop) {
  4780.     if (proto) {
  4781.         switch (*proto) {
  4782.         case '\0':
  4783.         return too_many_arguments(o, gv_ename(namegv));
  4784.         case ';':
  4785.         optional = 1;
  4786.         proto++;
  4787.         continue;
  4788.         case '$':
  4789.         proto++;
  4790.         arg++;
  4791.         scalar(o2);
  4792.         break;
  4793.         case '%':
  4794.         case '@':
  4795.         list(o2);
  4796.         arg++;
  4797.         break;
  4798.         case '&':
  4799.         proto++;
  4800.         arg++;
  4801.         if (o2->op_type != OP_REFGEN && o2->op_type != OP_UNDEF)
  4802.             bad_type(arg, "block", gv_ename(namegv), o2);
  4803.         break;
  4804.         case '*':
  4805.         proto++;
  4806.         arg++;
  4807.         if (o2->op_type == OP_RV2GV)
  4808.             goto wrapref;
  4809.         {
  4810.             OP* kid = o2;
  4811.             OP* sib = kid->op_sibling;
  4812.             kid->op_sibling = 0;
  4813.             o2 = newUNOP(OP_RV2GV, 0, kid);
  4814.             o2->op_sibling = sib;
  4815.             prev->op_sibling = o2;
  4816.         }
  4817.         goto wrapref;
  4818.         case '\\':
  4819.         proto++;
  4820.         arg++;
  4821.         switch (*proto++) {
  4822.         case '*':
  4823.             if (o2->op_type != OP_RV2GV)
  4824.             bad_type(arg, "symbol", gv_ename(namegv), o2);
  4825.             goto wrapref;
  4826.         case '&':
  4827.             if (o2->op_type != OP_RV2CV)
  4828.             bad_type(arg, "sub", gv_ename(namegv), o2);
  4829.             goto wrapref;
  4830.         case '$':
  4831.             if (o2->op_type != OP_RV2SV
  4832.             && o2->op_type != OP_PADSV
  4833.             && o2->op_type != OP_THREADSV)
  4834.             {
  4835.             bad_type(arg, "scalar", gv_ename(namegv), o2);
  4836.             }
  4837.             goto wrapref;
  4838.         case '@':
  4839.             if (o2->op_type != OP_RV2AV && o2->op_type != OP_PADAV)
  4840.             bad_type(arg, "array", gv_ename(namegv), o2);
  4841.             goto wrapref;
  4842.         case '%':
  4843.             if (o2->op_type != OP_RV2HV && o2->op_type != OP_PADHV)
  4844.             bad_type(arg, "hash", gv_ename(namegv), o2);
  4845.           wrapref:
  4846.             {
  4847.             OP* kid = o2;
  4848.             OP* sib = kid->op_sibling;
  4849.             kid->op_sibling = 0;
  4850.             o2 = newUNOP(OP_REFGEN, 0, kid);
  4851.             o2->op_sibling = sib;
  4852.             prev->op_sibling = o2;
  4853.             }
  4854.             break;
  4855.         default: goto oops;
  4856.         }
  4857.         break;
  4858.         case ' ':
  4859.         proto++;
  4860.         continue;
  4861.         default:
  4862.           oops:
  4863.         croak("Malformed prototype for %s: %s",
  4864.             gv_ename(namegv), SvPV((SV*)cv, PL_na));
  4865.         }
  4866.     }
  4867.     else
  4868.         list(o2);
  4869.     mod(o2, OP_ENTERSUB);
  4870.     prev = o2;
  4871.     o2 = o2->op_sibling;
  4872.     }
  4873.     if (proto && !optional &&
  4874.       (*proto && *proto != '@' && *proto != '%' && *proto != ';'))
  4875.     return too_few_arguments(o, gv_ename(namegv));
  4876.     return o;
  4877. }
  4878.  
  4879. OP *
  4880. ck_svconst(OP *o)
  4881. {
  4882.     SvREADONLY_on(cSVOPo->op_sv);
  4883.     return o;
  4884. }
  4885.  
  4886. OP *
  4887. ck_trunc(OP *o)
  4888. {
  4889.     if (o->op_flags & OPf_KIDS) {
  4890.     SVOP *kid = (SVOP*)cUNOPo->op_first;
  4891.  
  4892.     if (kid->op_type == OP_NULL)
  4893.         kid = (SVOP*)kid->op_sibling;
  4894.     if (kid &&
  4895.       kid->op_type == OP_CONST && (kid->op_private & OPpCONST_BARE))
  4896.         o->op_flags |= OPf_SPECIAL;
  4897.     }
  4898.     return ck_fun(o);
  4899. }
  4900.  
  4901. /* A peephole optimizer.  We visit the ops in the order they're to execute. */
  4902.  
  4903. void
  4904. peep(register OP *o)
  4905. {
  4906.     dTHR;
  4907.     register OP* oldop = 0;
  4908.     if (!o || o->op_seq)
  4909.     return;
  4910.     ENTER;
  4911.     SAVEOP();
  4912.     SAVESPTR(PL_curcop);
  4913.     for (; o; o = o->op_next) {
  4914.     if (o->op_seq)
  4915.         break;
  4916.     if (!PL_op_seqmax)
  4917.         PL_op_seqmax++;
  4918.     PL_op = o;
  4919.     switch (o->op_type) {
  4920.     case OP_NEXTSTATE:
  4921.     case OP_DBSTATE:
  4922.         PL_curcop = ((COP*)o);        /* for warnings */
  4923.         o->op_seq = PL_op_seqmax++;
  4924.         break;
  4925.  
  4926.     case OP_CONCAT:
  4927.     case OP_CONST:
  4928.     case OP_JOIN:
  4929.     case OP_UC:
  4930.     case OP_UCFIRST:
  4931.     case OP_LC:
  4932.     case OP_LCFIRST:
  4933.     case OP_QUOTEMETA:
  4934.         if (o->op_next && o->op_next->op_type == OP_STRINGIFY)
  4935.         null(o->op_next);
  4936.         o->op_seq = PL_op_seqmax++;
  4937.         break;
  4938.     case OP_STUB:
  4939.         if ((o->op_flags & OPf_WANT) != OPf_WANT_LIST) {
  4940.         o->op_seq = PL_op_seqmax++;
  4941.         break; /* Scalar stub must produce undef.  List stub is noop */
  4942.         }
  4943.         goto nothin;
  4944.     case OP_NULL:
  4945.         if (o->op_targ == OP_NEXTSTATE || o->op_targ == OP_DBSTATE)
  4946.         PL_curcop = ((COP*)o);
  4947.         goto nothin;
  4948.     case OP_SCALAR:
  4949.     case OP_LINESEQ:
  4950.     case OP_SCOPE:
  4951.       nothin:
  4952.         if (oldop && o->op_next) {
  4953.         oldop->op_next = o->op_next;
  4954.         continue;
  4955.         }
  4956.         o->op_seq = PL_op_seqmax++;
  4957.         break;
  4958.  
  4959.     case OP_GV:
  4960.         if (o->op_next->op_type == OP_RV2SV) {
  4961.         if (!(o->op_next->op_private & OPpDEREF)) {
  4962.             null(o->op_next);
  4963.             o->op_private |= o->op_next->op_private & OPpLVAL_INTRO;
  4964.             o->op_next = o->op_next->op_next;
  4965.             o->op_type = OP_GVSV;
  4966.             o->op_ppaddr = ppaddr[OP_GVSV];
  4967.         }
  4968.         }
  4969.         else if (o->op_next->op_type == OP_RV2AV) {
  4970.         OP* pop = o->op_next->op_next;
  4971.         IV i;
  4972.         if (pop->op_type == OP_CONST &&
  4973.             (PL_op = pop->op_next) &&
  4974.             pop->op_next->op_type == OP_AELEM &&
  4975.             !(pop->op_next->op_private &
  4976.               (OPpLVAL_INTRO|OPpLVAL_DEFER|OPpDEREF)) &&
  4977.             (i = SvIV(((SVOP*)pop)->op_sv) - PL_compiling.cop_arybase)
  4978.                 <= 255 &&
  4979.             i >= 0)
  4980.         {
  4981.             SvREFCNT_dec(((SVOP*)pop)->op_sv);
  4982.             null(o->op_next);
  4983.             null(pop->op_next);
  4984.             null(pop);
  4985.             o->op_flags |= pop->op_next->op_flags & OPf_MOD;
  4986.             o->op_next = pop->op_next->op_next;
  4987.             o->op_type = OP_AELEMFAST;
  4988.             o->op_ppaddr = ppaddr[OP_AELEMFAST];
  4989.             o->op_private = (U8)i;
  4990.             GvAVn(((GVOP*)o)->op_gv);
  4991.         }
  4992.         }
  4993.         o->op_seq = PL_op_seqmax++;
  4994.         break;
  4995.  
  4996.     case OP_PADAV:
  4997.         if (o->op_next->op_type == OP_RV2AV
  4998.         && (o->op_next->op_flags & OPf_REF))
  4999.         {
  5000.         null(o->op_next);
  5001.                o->op_next = o->op_next->op_next;
  5002.         }
  5003.         break;
  5004.     
  5005.     case OP_PADHV:
  5006.         if (o->op_next->op_type == OP_RV2HV
  5007.         && (o->op_next->op_flags & OPf_REF))
  5008.         {
  5009.         null(o->op_next);
  5010.                o->op_next = o->op_next->op_next;
  5011.         }
  5012.         break;
  5013.  
  5014.     case OP_MAPWHILE:
  5015.     case OP_GREPWHILE:
  5016.     case OP_AND:
  5017.     case OP_OR:
  5018.         o->op_seq = PL_op_seqmax++;
  5019.         while (cLOGOP->op_other->op_type == OP_NULL)
  5020.         cLOGOP->op_other = cLOGOP->op_other->op_next;
  5021.         peep(cLOGOP->op_other);
  5022.         break;
  5023.  
  5024.     case OP_COND_EXPR:
  5025.         o->op_seq = PL_op_seqmax++;
  5026.         peep(cCONDOP->op_true);
  5027.         peep(cCONDOP->op_false);
  5028.         break;
  5029.  
  5030.     case OP_ENTERLOOP:
  5031.         o->op_seq = PL_op_seqmax++;
  5032.         peep(cLOOP->op_redoop);
  5033.         peep(cLOOP->op_nextop);
  5034.         peep(cLOOP->op_lastop);
  5035.         break;
  5036.  
  5037.     case OP_QR:
  5038.     case OP_MATCH:
  5039.     case OP_SUBST:
  5040.         o->op_seq = PL_op_seqmax++;
  5041.         peep(cPMOP->op_pmreplstart);
  5042.         break;
  5043.  
  5044.     case OP_EXEC:
  5045.         o->op_seq = PL_op_seqmax++;
  5046.         if (PL_dowarn && o->op_next && o->op_next->op_type == OP_NEXTSTATE) {
  5047.         if (o->op_next->op_sibling &&
  5048.             o->op_next->op_sibling->op_type != OP_EXIT &&
  5049.             o->op_next->op_sibling->op_type != OP_WARN &&
  5050.             o->op_next->op_sibling->op_type != OP_DIE) {
  5051.             line_t oldline = PL_curcop->cop_line;
  5052.  
  5053.             PL_curcop->cop_line = ((COP*)o->op_next)->cop_line;
  5054.             warn("Statement unlikely to be reached");
  5055.             warn("(Maybe you meant system() when you said exec()?)\n");
  5056.             PL_curcop->cop_line = oldline;
  5057.         }
  5058.         }
  5059.         break;
  5060.     
  5061.     case OP_HELEM: {
  5062.         UNOP *rop;
  5063.         SV *lexname;
  5064.         GV **fields;
  5065.         SV **svp, **indsvp;
  5066.         I32 ind;
  5067.         char *key;
  5068.         STRLEN keylen;
  5069.     
  5070.         if (o->op_private & (OPpDEREF_HV|OPpDEREF_AV|OPpLVAL_INTRO)
  5071.         || ((BINOP*)o)->op_last->op_type != OP_CONST)
  5072.         break;
  5073.         rop = (UNOP*)((BINOP*)o)->op_first;
  5074.         if (rop->op_type != OP_RV2HV || rop->op_first->op_type != OP_PADSV)
  5075.         break;
  5076.         lexname = *av_fetch(PL_comppad_name, rop->op_first->op_targ, TRUE);
  5077.         if (!SvOBJECT(lexname))
  5078.         break;
  5079.         fields = (GV**)hv_fetch(SvSTASH(lexname), "FIELDS", 6, FALSE);
  5080.         if (!fields || !GvHV(*fields))
  5081.         break;
  5082.         svp = &((SVOP*)((BINOP*)o)->op_last)->op_sv;
  5083.         key = SvPV(*svp, keylen);
  5084.         indsvp = hv_fetch(GvHV(*fields), key, keylen, FALSE);
  5085.         if (!indsvp) {
  5086.         croak("No such field \"%s\" in variable %s of type %s",
  5087.               key, SvPV(lexname, PL_na), HvNAME(SvSTASH(lexname)));
  5088.         }
  5089.         ind = SvIV(*indsvp);
  5090.         if (ind < 1)
  5091.         croak("Bad index while coercing array into hash");
  5092.         rop->op_type = OP_RV2AV;
  5093.         rop->op_ppaddr = ppaddr[OP_RV2AV];
  5094.         o->op_type = OP_AELEM;
  5095.         o->op_ppaddr = ppaddr[OP_AELEM];
  5096.         SvREFCNT_dec(*svp);
  5097.         *svp = newSViv(ind);
  5098.         break;
  5099.     }
  5100.  
  5101.     default:
  5102.         o->op_seq = PL_op_seqmax++;
  5103.         break;
  5104.     }
  5105.     oldop = o;
  5106.     }
  5107.     LEAVE;
  5108. }
  5109.